Masato Kikuhara
en-sf****@users*****
2005年 6月 30日 (木) 07:57:14 JST
Index: affelio/apps/diary/extlib/XML/RSS/LP.pm diff -u affelio/apps/diary/extlib/XML/RSS/LP.pm:1.1 affelio/apps/diary/extlib/XML/RSS/LP.pm:removed --- affelio/apps/diary/extlib/XML/RSS/LP.pm:1.1 Thu Jun 30 02:38:50 2005 +++ affelio/apps/diary/extlib/XML/RSS/LP.pm Thu Jun 30 07:57:13 2005 @@ -1,272 +0,0 @@ -package XML::RSS::LP; - -# XML::RSS:LP -# -# A liberal parser for RSS Feeds. -# -# Copyright (c) 2002 Timothy Appnel -# http://tima.mplode.com/ -# -# This software is provided 'as-is', without any express or implied -# warranty. In no event will the authors be held liable for any damages -# arising from the use of this software. -# -# Permission is granted to anyone to use this software for any purpose, -# including commercial applications, and to alter it and redistribute it -# freely, subject to the following restrictions: -# -# 1. The origin of this software must not be misrepresented; you must not -# claim that you wrote the original software. If you use this software -# in a product, an acknowledgment in the product documentation would be -# appreciated but is not required. -# 2. Altered source versions must be plainly marked as such, and must not be -# misrepresented as being the original software. -# 3. This notice may not be removed or altered from any source distribution. -# -# -# Requires the XML::Parser or XML::Parser::Lite. -# -# Usage -# ----- -# -# use XML::RSS::LP; -# -# my $rss = new XML::RSS::LP; -# $rss->parsefile('foo.rss'); -# print "$rss->{channel}->{title}\n"; -# foreach (@{ $rss->{items} }) { -# print "$_->{title} [$_->{link}]\n"; -# } -# -# -# Changelog -# --------- -# 0.1 September 02 2002 -# - Initial Release -# -# 0.2 October 30 2002 -# - Borrowing heavily from XML::Parser::Expat improved and proper namespace handling including... -# - namespace, eq_name, generate_ns_name, expand_prefix, current_ns_prefixes routines added. -# - Added tag_name and namespace_prefix utility routines. -# - Added namespace parsing and store code to start handler -# - Modified character handler to take advantage of namespace awareness -# -# -# Implementation Notes -# -------------------- -# Originally inspired by my own work developing a homegrown RSS feed aggregator with -# Blagg [] and Mark Pilgrim's writing []. -# this package is similar in function to the parsing capabilities of XML::RSS, but -# more lightweight and liberal in its enforcement of RSS feeds. XML::RSS:LP is not -# "ultra" liberal -- it still requires feeds to be well-formed XML. Utilizes -# XML::Parser, but falls back on XML:Parser:Lite if not available. -# -# * requires RSS feed to be well-formed XML but... -# * does not validate or force conformance to a specific RSS spec thereby... -# * allowing mixes of .9x and 1.0 tags and 1.0 modules -# * allowing for unknown and made-up tags. -# * implements very "loose" namespace functionality. -# * ignores skiphours, skipdays, textinput. (did i miss any defined others?) -# - -sub xmlparser { - my $self = shift; - return eval { require XML::Parser; XML::Parser->new } || - eval { require XML::Parser::Lite; XML::Parser::Lite->new } || - die 'XML::Parser is not available'; -} - -sub parser { - my $self = shift->new; - @_ ? ($self->{'_parser'} = shift, return $self) : return ($self->{'_parser'} ||= $self->xmlparser); -} - -sub new { - my $self = shift; - my $class = ref($self) || $self; - return $self if ref $self; # ???? - return bless {_parser => shift} => $class; -} - -sub init { } - -sub parse { - my $self = shift; - $self->parser->setHandlers( - Init => sub { shift; $self->init_handler(@_) }, - Final => sub { shift; $self->final_handler(@_) }, - Start => sub { shift; $self->start_handler(@_) }, - End => sub { shift; $self->end_handler(@_) }, - Char => sub { shift; $self->char_handler(@_) } - ); - $self->{_unparsed}=$_[0]; - $self->parser->parse($_[0]); -} - -sub parsefile { - my $self=shift; - my $file=shift; - open(FH, "< $file"); - my $contents=join('',<FH>); - close(FH); - $self->parse($contents); -} - -sub as_string { shift->{_unparsed} } - -sub init_handler { undef shift->{_values}; } #inits vars. others? item_num? _done? - -sub final_handler { shift->{_done} } - -sub start_handler { - my $self=shift; -#warn "start_handler $self\n"; - my $element=shift; - my $flag; - - # store namespaces mapping - while (@_) { - my($prefix,$url) = splice(@_, 0, 2); - if (substr($prefix,0,5) eq 'xmlns') { - $prefix=length($prefix)>5?substr($prefix,6):'#default'; -#warn "$prefix, $url\n"; - my $stack = $self->{prefix_table}->{$prefix}; - if (defined $stack) { push(@$stack, $url); } - else { - $self->{prefix_table}->{$prefix} = [$url]; # why an array? - push(@{$self->{namespace_list}},$url); - } - $flag=1; - } - } - - #generate namespace_list if new namespaces where taken in. - if ($flag) { - my $count; - foreach (@{ $self->{namespace_list} }) { - $count++; - $self->{namespace_table}->{$_}=$count; }; - $flag=0; - } - - # namespace qualify element if necessary. - if ($self->{prefix_table}) { - if ($self->namespace_prefix($element)) { - $element=$self->generate_ns_name($self->tag_name($element),$self->expand_ns_prefix($self->namespace_prefix($element))); - } - elsif ($self->{prefix_table}->{'#default'}) { - $element=$self->generate_ns_name($element,$self->expand_ns_prefix('#default')); - } - } - push @{$self->{_values}}, [$element, {@_}]; - $self->{num_items}++ if ($self->eq_name($element,$self->generate_ns_name('item',$self->expand_ns_prefix('#default')))); # can combine with the above line. -} - -sub char_handler { - my $self= shift; - my $cdata =shift; -#warn "start char handler\n"; - - if ($self->within_element($self->generate_ns_name('image',$self->expand_ns_prefix('#default')))) { - $self->{'image'}->{$self->current_element} .= $cdata; - } elsif ($self->within_element($self->generate_ns_name('item',$self->expand_ns_prefix('#default')))) { - $self->{'items'}->[$self->{num_items}-1]->{$self->current_element} .= $cdata; - } elsif ($self->within_element($self->generate_ns_name('channel',$self->expand_ns_prefix('#default')))) { - $self->{'channel'}->{$self->current_element} .= $cdata; - } -} - -sub end_handler { - my $self = shift; - my $done = pop @{$self->{_values}}; - $self->{_done}=$done unless(@{$self->{_values}}); -} - -sub within_element { - my $self=shift; - my $element=shift; - my $count=0; - foreach (@{ $self->{_values} }) { $count++ if $_->[0] eq $element; } - $count-- unless ($self->current_element ne $element); # SHOULD THIS SUB COUNT THE CURRENT ITEM? GUESSING NO. - return $count; -} - -sub current_element { return shift->{_values}->[-1]->[0] } #if defined. - -# Namespace routines. - -sub namespace { # assuming tag with prefix handed in. - my $self = shift; - my $prefix = shift; - if ($self->{prefix_table}) { - if ($self->namespace_prefix($prefix)) { return $self->expand_ns_prefix($self->namespace_prefix($prefix)); } - else { return $self->expand_ns_prefix('#default') } - } - return undef; -} - -sub eq_name { # unlike Expat it will take in an array of namespace qualified or prefixed elements to compare. - my $self = shift; - my $count=0; - my $compare; - foreach (@_) { - my $nsq_name=$_; - if ($self->namespace_prefix($_)) { $nsq_name=$self->generate_ns_name($self->tag_name($_),$self->namespace($self->namespace_prefix($_))); } - elsif ($self->{prefix_table}->{'#default'}) { $nsq_name=$self->generate_ns_name($_,'#default'); } - (defined $compare && ($nsq_name ne $compare)) ? return 0 : 1; - $compare=$nsq_name; - $count++; - } - return $count; -} - -sub generate_ns_name { - my ($self, $name, $namespace) = @_; - if ($self->{namespace_table}->{$namespace}) { - $namespace .= '/' unless $namespace=~/\/$/; # necessary? - return $namespace .$name; - } - else { return $name; } -} - -sub expand_ns_prefix { - my $self = shift; - my $prefix = shift; - my $stack = $self->{prefix_table}->{$prefix}; - return (defined($stack) and @$stack) ? $stack->[-1] : ''; # switched to null string from undef -} - -sub current_ns_prefixes { - my $self = shift; - my %set = %{ $self->{prefix_table} }; - if (exists $set{'#default'} and not defined($set{'#default'}->[-1])) { - delete $set{'#default'}; - } - return keys %set; -} - -# Namespace utility subroutines. - -sub tag_name { - shift; - my($prefix,$name)=split(/:/,shift); - return $name || $prefix; -} - -sub namespace_prefix { - shift; - my($prefix,$name)=split(/:/,shift); - return $name?$prefix:undef; -} - - -# Would be helpful if in a streamed parser. -# -# sub context { return @{ shift->{_values} } } #returns array in context. -# sub in_element { return shift->{_values}->[-1] eq shift } -# sub depth { return int(@{ shift->{_values} }) } #Returns the size of the context list. - -#sub xml_decode { } -# NG LP.pm: Override handlers? - -1;