<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">
# 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 =&gt; "GetXML $VERSION",
        description =&gt; 'Fetch and display arbitrary XML data using the &lt;code&gt;XML::Simple&lt;/code&gt; Perl module.',
        doc_link =&gt; 'http://www.staggernation.com/mtplugins/GetXML'
    }; 
    MT-&gt;add_plugin(new MT::Plugin($plugin));
}

MT::Template::Context-&gt;add_container_tag('GetXML' =&gt; sub{&amp;_hdlr_get_xml;});
MT::Template::Context-&gt;add_container_tag('GetXMLElement' =&gt; sub{&amp;_hdlr_get_xml_element;});
MT::Template::Context-&gt;add_conditional_tag('IfXMLElementExists' =&gt; sub{&amp;_hdlr_if_xml_element_exists;});
MT::Template::Context-&gt;add_conditional_tag('IfXMLElementNotExists' =&gt; sub{&amp;_hdlr_if_xml_element_not_exists;});
MT::Template::Context-&gt;add_tag('GetXMLValue' =&gt; sub{&amp;_hdlr_get_xml_value;});
MT::Template::Context-&gt;add_tag('GetXMLElementCount' =&gt; sub{&amp;_hdlr_get_xml_element_count;});
MT::Template::Context-&gt;add_tag('GetXMLElementIndex' =&gt; sub{&amp;_hdlr_get_xml_element_index;});
MT::Template::Context-&gt;add_tag('GetXMLURL' =&gt; sub{&amp;_hdlr_get_xml_url;});
MT::Template::Context-&gt;add_tag('GetXMLCacheDate' =&gt; sub{&amp;_hdlr_get_xml_cache_date;});
MT::Template::Context-&gt;add_tag('GetXMLDump' =&gt; sub{&amp;_hdlr_get_xml_dump;});
MT::Template::Context-&gt;add_global_filter('space_to_plus' =&gt; sub{&amp;_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-&gt;error('No location passed') unless $args-&gt;{'location'};
	eval { require LWP::Simple; };
	$@ &amp;&amp; (return $ctx-&gt;error("Error loading LWP::Simple module: $@"));
	eval { require XML::Simple; };
	$@ &amp;&amp; (return $ctx-&gt;error("Error loading XML::Simple module: $@"));
	my $builder = $ctx-&gt;stash('builder');
	my $tokens = $ctx-&gt;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-&gt;{$key});
		next unless $val;
		$val = encode_url($val);
			# de-encode plus signs
		$val =~ s/%2B/+/g;
		$url_args .= "$key=" . $val . '&amp;';
	}
	my $location = build_value($ctx, $args-&gt;{'location'});
	$url_args =~ s/&amp;$//;
	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-&gt;{$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-&gt;{$_}) {
			$cache_key .= $_ . $args-&gt;{$_};
		}
	}
	$cache_key .= ']';
		# try to load a cached copy
	my $cached = 0;
	my $cachable = 1;
		# pass cache="0" to suppress caching
	if (exists($args-&gt;{'cache'}) &amp;&amp; ($args-&gt;{'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-&gt;load({
				plugin =&gt; 'GetXML', key =&gt; $cache_key
			});
			if ($pdata) {
				my $data = $pdata-&gt;data;
				my $mins_ago = (time() - $data-&gt;{'time'}) / 60;
				if ($mins_ago &lt; ($args-&gt;{'cache'} || $DEFAULT_CACHE_MINS)) {
					$xml_data = $data-&gt;{'xml_data'};
					$cached = 1;
					$cache_time = $data-&gt;{'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-&gt;load({
				plugin =&gt; 'GetXML', key =&gt; $cache_key
			});
			if (!$pdata) {
				$pdata = MT::PluginData-&gt;new;
			}
			$pdata-&gt;plugin('GetXML');
			$pdata-&gt;key($cache_key);
			$cache_time = time();
			$pdata-&gt;data({'time' =&gt; $cache_time, 'xml_data' =&gt; $xml_data});
				# no need to die on an error, we don't care that much
			$pdata-&gt;save;
		}
	}
	local $ctx-&gt;{__stash}{'mtgetxml_data'} = $xml_data;
	local $ctx-&gt;{__stash}{'mtgetxml_cachetime'} = $cache_time;
	local $ctx-&gt;{__stash}{'mtgetxml_url'} = $url;
	defined(my $text = $builder-&gt;build($ctx, $tokens, $cond))
		|| return $ctx-&gt;error($ctx-&gt;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-&gt;stash('mtgetxml_data'))
		|| return $ctx-&gt;error('Not called from within MTGetXML container');
	my $name = $args-&gt;{'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 &amp;&amp; !ref($data)) {
			return $data;
		} else {
			return $ctx-&gt;error('No element name passed');
		}
	}
	my $builder = $ctx-&gt;stash('builder');
	my $tokens = $ctx-&gt;stash('tokens');
	$name = build_value($ctx, $name);
	if (ref($data) eq 'HASH') {
		my $elem = $data-&gt;{$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-&gt;{'limit'} &amp;&amp; ($i &gt; $args-&gt;{'limit'}));                                                                       
			local $ctx-&gt;{__stash}{'mtgetxml_data'} = $e;
			local $ctx-&gt;{__stash}{'mtgetxml_index'} = $i;
			defined(my $iter = $builder-&gt;build($ctx, $tokens, $cond))
				|| return $ctx-&gt;error($ctx-&gt;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-&gt;stash('mtgetxml_data'))
		|| return $ctx-&gt;error('Not called from within MTGetXML container');
	(my $name = $args-&gt;{'name'})
		|| return $ctx-&gt;error('No element name passed');
	my $exists = 1;
	if ((ref($data) ne 'HASH') || !exists($data-&gt;{$name})) {
		$exists = 0;
	}
	return ($exists == $want_elem) ? 1 : 0;
}

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

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

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

sub _hdlr_get_xml_cache_date {
	my ($ctx, $args) = @_;
	(my $time = $ctx-&gt;stash('mtgetxml_cachetime'))
		|| return $ctx-&gt;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-&gt;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-&gt;{'format'}, $ts, $ctx-&gt;stash('blog'), $args-&gt;{'language'});
}

sub _hdlr_get_xml_dump {
	my ($ctx, $args) = @_;
	(my $data = $ctx-&gt;stash('mtgetxml_data'))
		|| return $ctx-&gt;error('Not called from within MTGetXML container');
	require Data::Dumper;
	my $dump = Data::Dumper-&gt;new([ $data ]);
	$dump-&gt;Pad('&lt;br/&gt;');
	$dump-&gt;Indent(1);
	my $dump_text = $dump-&gt;Dump;
	$dump_text =~ s!^&lt;br/&gt;\$VAR1 = !!;
	$dump_text =~ s!(\n&lt;br/&gt;)( +)!$1.('&amp;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-&gt;{'errors'} || $DEFAULT_ERRORS);
	if ($behavior eq 'die') {
		return $ctx-&gt;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/(?&lt;!\\)\[/&lt;/g;
	$value =~ s/(?&lt;!\\)\]/&gt;/g;
	$value =~ s/(?&lt;!\\)'/"/g;
		# de-escape escaped []'
	$value =~ s/\\([\[\]'])/$1/g;
		# any MT tags?
	if ($value =~ /&lt;MT/) {
		my $builder = $ctx-&gt;stash('builder');
		my $tok = $builder-&gt;compile($ctx, $value);
		$value = $builder-&gt;build($ctx, $tok);
		return $ctx-&gt;error($builder-&gt;errstr) unless defined($value);
	}
	return $value;
}

1;</pre></body></html>