# $File: //depot/MT/mt/lib/XML/RSS/LP.pm $ $Author: autrijus $
# $Revision: #1 $ $Change: 3721 $ $DateTime: 2003/01/20 20:29:36 $

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;
