# GetXML.pl
# Movable Type plugin tag for getting and displaying an XML feed
# by Kevin Shay
# http://www.staggernation.com/mtplugins/
# last modified July 12, 2004

package MT::Plugin::GetXML;
use strict;
use vars qw( $VERSION );
$VERSION = '1.1';

use MT;
use MT::Template::Context;

eval{ require MT::Plugin };
unless ($@) {
    my $plugin = {
        name => "GetXML $VERSION",
        description => 'Fetch and display arbitrary XML data using the <code>XML::Simple</code> Perl module.',
        doc_link => 'http://www.staggernation.com/mtplugins/GetXML'
    }; 
    MT->add_plugin(new MT::Plugin($plugin));
}

MT::Template::Context->add_container_tag('GetXML' => sub{&_hdlr_get_xml;});
MT::Template::Context->add_container_tag('GetXMLElement' => sub{&_hdlr_get_xml_element;});
MT::Template::Context->add_conditional_tag('IfXMLElementExists' => sub{&_hdlr_if_xml_element_exists;});
MT::Template::Context->add_conditional_tag('IfXMLElementNotExists' => sub{&_hdlr_if_xml_element_not_exists;});
MT::Template::Context->add_tag('GetXMLValue' => sub{&_hdlr_get_xml_value;});
MT::Template::Context->add_tag('GetXMLElementCount' => sub{&_hdlr_get_xml_element_count;});
MT::Template::Context->add_tag('GetXMLElementIndex' => sub{&_hdlr_get_xml_element_index;});
MT::Template::Context->add_tag('GetXMLURL' => sub{&_hdlr_get_xml_url;});
MT::Template::Context->add_tag('GetXMLCacheDate' => sub{&_hdlr_get_xml_cache_date;});
MT::Template::Context->add_tag('GetXMLDump' => sub{&_hdlr_get_xml_dump;});
MT::Template::Context->add_global_filter('space_to_plus' => sub{&_hdlr_space_to_plus;});

	# edit this line to change the default caching time
my $DEFAULT_CACHE_MINS = 15;
	# edit this line to change the default error behavior
	# (display|warn|die|ignore)
my $DEFAULT_ERRORS = 'display';

my @xml_attrs = qw( noattr keeproot suppressempty );
	# tag attributes to MTGetXML that we don't want to add to the URL
my $non_url_attrs = join('|', @xml_attrs, qw( cache location errors ));

sub _hdlr_get_xml {
	my ($ctx, $args, $cond) = @_;
	return $ctx->error('No location passed') unless $args->{'location'};
	eval { require LWP::Simple; };
	$@ && (return $ctx->error("Error loading LWP::Simple module: $@"));
	eval { require XML::Simple; };
	$@ && (return $ctx->error("Error loading XML::Simple module: $@"));
	my $builder = $ctx->stash('builder');
	my $tokens = $ctx->stash('tokens');
		# build any MT tags in passed value
	my $url_args = '';
	use MT::Util qw( encode_url );
	for my $key (keys %$args) {
		next if ($key =~ /^$non_url_attrs$/);
		my $val = build_value($ctx, $args->{$key});
		next unless $val;
		$val = encode_url($val);
			# de-encode plus signs
		$val =~ s/%2B/+/g;
		$url_args .= "$key=" . $val . '&';
	}
	my $location = build_value($ctx, $args->{'location'});
	$url_args =~ s/&$//;
	my $url = $url_args ? "$location?$url_args" : $location;
	my $xml_data = {};
	my $cache_time = -1;
	my %xml_opts = ();
	for my $xml_attr (@xml_attrs) {
		$xml_opts{$xml_attr} = 1 if $args->{$xml_attr};
	}
	$xml_opts{'keyattr'} = [];
		# data structure will be different with different options, so
		# append the options to the URL for the cache key
	my $cache_key = $url . '[';
	for (sort keys %xml_opts) {
		if ($args->{$_}) {
			$cache_key .= $_ . $args->{$_};
		}
	}
	$cache_key .= ']';
		# try to load a cached copy
	my $cached = 0;
	my $cachable = 1;
		# pass cache="0" to suppress caching
	if (exists($args->{'cache'}) && ($args->{'cache'} eq '0')) {
		$cachable = 0;
	} else {
			# if we can't load MT::PluginData (either too old a version of MT
			# or Storable is not available), just skip it
		eval { require MT::PluginData; };
		if ($@) {
			$cachable = 0;
		} else {
			my ($pdata) = MT::PluginData->load({
				plugin => 'GetXML', key => $cache_key
			});
			if ($pdata) {
				my $data = $pdata->data;
				my $mins_ago = (time() - $data->{'time'}) / 60;
				if ($mins_ago < ($args->{'cache'} || $DEFAULT_CACHE_MINS)) {
					$xml_data = $data->{'xml_data'};
					$cached = 1;
					$cache_time = $data->{'time'};
				}
			}
		}
	}
	if (!$cached) {
		my $xml = LWP::Simple::get($url);
		return error($ctx, $args, "$url: page not found") unless $xml;
		eval { $xml_data = XML::Simple::XMLin($xml, %xml_opts); };
		if ($@) {
			return error($ctx, $args, "$url: $@");
		}
		if ($cachable) {
			my ($pdata) = MT::PluginData->load({
				plugin => 'GetXML', key => $cache_key
			});
			if (!$pdata) {
				$pdata = MT::PluginData->new;
			}
			$pdata->plugin('GetXML');
			$pdata->key($cache_key);
			$cache_time = time();
			$pdata->data({'time' => $cache_time, 'xml_data' => $xml_data});
				# no need to die on an error, we don't care that much
			$pdata->save;
		}
	}
	local $ctx->{__stash}{'mtgetxml_data'} = $xml_data;
	local $ctx->{__stash}{'mtgetxml_cachetime'} = $cache_time;
	local $ctx->{__stash}{'mtgetxml_url'} = $url;
	defined(my $text = $builder->build($ctx, $tokens, $cond))
		|| return $ctx->error($ctx->errstr);
	return $text;
}

sub _hdlr_get_xml_element {
	my ($ctx, $args, $cond) = @_;
	return get_value($ctx, $args, $cond);
}

sub _hdlr_get_xml_value {
	my ($ctx, $args, $cond) = @_;
	return get_value($ctx, $args, $cond, 1);
}

sub get_value {
	my ($ctx, $args, $cond, $want_val) = @_;
	(my $data = $ctx->stash('mtgetxml_data'))
		|| return $ctx->error('Not called from within MTGetXML container');
	my $name = $args->{'name'};
	if (!$name) {
			# if containing tag was looping through an array of simple
			# values, can call MTGetXMLValue without a name and it will
			# return the stashed value
		if ($want_val && !ref($data)) {
			return $data;
		} else {
			return $ctx->error('No element name passed');
		}
	}
	my $builder = $ctx->stash('builder');
	my $tokens = $ctx->stash('tokens');
	$name = build_value($ctx, $name);
	if (ref($data) eq 'HASH') {
		my $elem = $data->{$name};
		if (!ref($elem)) {
			return $elem ? $elem : '';
		}
		if ($want_val) {
			if (ref($elem) eq 'ARRAY') {
					# if an array consists entirely of simple values, just
					# concatenate them and return the result
				if (join('', map { ref($_) } @$elem) eq '') {
					return join('', @$elem);
				}
			}
			return error($ctx, $args, "XML element '$name' contains multiple values");
		}
		if (ref($elem) eq 'HASH') {
			$elem = [ $elem ];
		}
		my $text = '';
		my $i = 0;
		for my $e (@$elem) {
			$i++;
			last if ($args->{'limit'} && ($i > $args->{'limit'}));                                                                       
			local $ctx->{__stash}{'mtgetxml_data'} = $e;
			local $ctx->{__stash}{'mtgetxml_index'} = $i;
			defined(my $iter = $builder->build($ctx, $tokens, $cond))
				|| return $ctx->error($ctx->errstr);
			$text .= $iter;
		}
		return $text;
	}
}

sub _hdlr_if_xml_element_exists {
	my ($ctx, $args) = @_;
	return element_exists($ctx, $args, 1);
}

sub _hdlr_if_xml_element_not_exists {
	my ($ctx, $args) = @_;
	return element_exists($ctx, $args, 0);
}

sub element_exists {
	my ($ctx, $args, $want_elem) = @_;
	(my $data = $ctx->stash('mtgetxml_data'))
		|| return $ctx->error('Not called from within MTGetXML container');
	(my $name = $args->{'name'})
		|| return $ctx->error('No element name passed');
	my $exists = 1;
	if ((ref($data) ne 'HASH') || !exists($data->{$name})) {
		$exists = 0;
	}
	return ($exists == $want_elem) ? 1 : 0;
}

sub _hdlr_get_xml_element_count {
	my ($ctx, $args) = @_;
	(my $data = $ctx->stash('mtgetxml_data'))
		|| return $ctx->error('Not called from within MTGetXML container');
	(my $name = $args->{'name'})
		|| return $ctx->error('No element name passed');
	if ((ref($data) eq 'HASH') && (ref($data->{$name}) eq 'ARRAY')) {
		return scalar(@{$data->{$name}});
	}
	return 1;
}

sub _hdlr_get_xml_element_index {
	my ($ctx, $args) = @_;
	(my $i = $ctx->stash('mtgetxml_index'))
		|| return $ctx->error('Not called from within MTGetXMLElement container');
	return $i;
}

sub _hdlr_get_xml_url {
	my ($ctx, $args) = @_;
	(my $url = $ctx->stash('mtgetxml_url'))
		|| return $ctx->error('Not called from within MTGetXML container');
	return $url;
}

sub _hdlr_get_xml_cache_date {
	my ($ctx, $args) = @_;
	(my $time = $ctx->stash('mtgetxml_cachetime'))
		|| return $ctx->error('Not called from within MTGetXML container');
	return '[Not cached]' if ($time == -1);
	use MT::Util qw( offset_time_list format_ts );
	my @tl = offset_time_list($time, $ctx->stash('blog_id'));
	my $ts = sprintf "%04d%02d%02d%02d%02d%02d",
        $tl[5]+1900, $tl[4]+1, @tl[3,2,1,0];
    return format_ts($args->{'format'}, $ts, $ctx->stash('blog'), $args->{'language'});
}

sub _hdlr_get_xml_dump {
	my ($ctx, $args) = @_;
	(my $data = $ctx->stash('mtgetxml_data'))
		|| return $ctx->error('Not called from within MTGetXML container');
	require Data::Dumper;
	my $dump = Data::Dumper->new([ $data ]);
	$dump->Pad('<br/>');
	$dump->Indent(1);
	my $dump_text = $dump->Dump;
	$dump_text =~ s!^<br/>\$VAR1 = !!;
	$dump_text =~ s!(\n<br/>)( +)!$1.('&nbsp;' x length($2))!eg;
	return $dump_text;
}

sub _hdlr_space_to_plus {
# global filter that converts whitespace to plus signs
	my ($val, $arg, $ctx) = @_;
	if ($arg eq '1') {
		$val =~ s/\s+/+/g;
		$val =~ s/\+$//;
	}
	return $val;
}

sub error {
# error handling: display on page, ignore, warn, or die (throw build error)
	my ($ctx, $args, $err) = @_;
	my $behavior = ($args->{'errors'} || $DEFAULT_ERRORS);
	if ($behavior eq 'die') {
		return $ctx->error($err);
	} elsif	($behavior eq 'warn') {
		warn $err;
		return '';
	} elsif ($behavior eq 'ignore') {
		return '';
	} else {
		return "[$err]";
	}
}

sub build_value {
# convert and build MT template tags within a passed value.
	my ($ctx, $value) = @_;
		# within a value argument, you can use MT tags, but with
		# square brackets instead of angle brackets and single quotes
		# instead of double quotes; literal square brackets and single
		# quotes must be escaped with a backslash
		# convert non-escaped []'
	$value =~ s/(?<!\\)\[/</g;
	$value =~ s/(?<!\\)\]/>/g;
	$value =~ s/(?<!\\)'/"/g;
		# de-escape escaped []'
	$value =~ s/\\([\[\]'])/$1/g;
		# any MT tags?
	if ($value =~ /<MT/) {
		my $builder = $ctx->stash('builder');
		my $tok = $builder->compile($ctx, $value);
		$value = $builder->build($ctx, $tok);
		return $ctx->error($builder->errstr) unless defined($value);
	}
	return $value;
}

1;