#   $Id: example-5.pod 56 2008-06-23 16:54:31Z adam $

=head1 NAME

Example-5 - A complete web server based RSS-client

=head2 Example 5

The following example is a complete web server based RSS-Client. The XSL stylesheet from the previous
example should work perfectly for the example to function. The example is slightly larger, so it has
been broken down into smaller logical units. The listing here works well as either an C<Apache::Registry> 
or a plain CGI application. The example also includes server side data caching - for simple low volume usage,
something that a dedicated caching-proxy is better able to provide in high volume use.

In listing B<1> the typical Perl pragma and CGI modules are loaded. The
C<Cache::FileCache> module is loaded to provide light-weight data caching. The hash
C<%config> stores configuration data, this data could easily be loaded in from one of the
many configuration file modules.


=head3 1: Main core of application

	#!/usr/bin/perl
	use strict;
	use warnings;
	use CGI;
	use CGI::Carp;
	use XML::RSS::Tools;
	use Cache::FileCache;
		$|++;
		my $q = CGI->new;
		my %config= (
			xsl_path => '/usr/local/apache/cgi-bin/',
			css1     => '/style/style.css',
			css2     => '/style/news-style.css',
			title    => 'i r e d a l e consulting | News Feeds |',
			language => 'en-GB',
			namespace=> 'xhtml',
			cache_depth    => 1,
			auto_purge     => '+2h',
			default_expire => '+1h',
			cache_root     => '/tmp/FileCache/news');
		my $input = process_params($q);
		top_html($q, $input, \%config);
		tad ("Usage: news2html.pl?site=uri;style=xsl[;cache=off | ;debug=on]\n", $q)
			unless $input->{uri} &amp;&amp; $input->{xsl};
		my ($cache, $cache_key, $data) = manage_cache($q, $input, \%config);
		$data = process_rss_feed($q, $input, \%config) unless $data;
		print $data;
		end_fragment($q, $input);
		$cache->set($cache_key, $data) if $cache;
		%ENV = ();
		exit;

In listing B<2>, the input parameters are extracted using C<CGI.pm> and
returned as a reference to a hash.

=head3 2: Processing Input parameters

	sub process_params {
		my $q = shift;
		my %p;
		$p{uri}  = $q->param("site") if $q->param("site");
		$p{xsl}  = $q->param("style") if $q->param("style");
		$p{debug}= $q->param("debug") if $q->param("debug");
		$p{cache_status} = lc($q->param("cache")) || "on";
		return \%p;
	}

In listing B<3>, the normal HTTP headers and the top of the HTML is sent to the browser using C<CGI>. Should
any error occur now, the browser should get a message, rather than a 500 error.

=head3 3: Sending the HTTP headers and starting the HTML

	sub top_html {
		my $q     = shift;
		my $input = shift;
		my $config= shift;
		$input->{uri} = "No Site URI" unless $input->{uri};
		$input->{xsl} = "No XSL stylesheet" unless $input->{xsl};
		print $q->header(-type      => "text/html",
		                 -expires   => $config->{default_expire}),
		      $q->start_html(-title => $config->{title} . " " . $input->{uri} . " and " . $input->{xsl},
		                     -lang  => $config->{language}, 
		                     -style => {-src => $config->{css1},
		                     	        -verbatim => '@import url(' . $config->{css2} . ');'}
		);
		print $q->comment("\nInput Conditions:\nURI: ", $input->{uri},
		                              "\nxsl sheet: ", $input->{xsl},
		                              "\nCache:     ", $input->{cache_status}, "\n") if $input->{debug}; 
	};

In listing B<4>, a cache key is created from the RSS feed URI and the name of the XSL stylesheet.
A C<FileCache> object is created. If the user requested an uncached object then the cache object and key
are returned and any data stored against the cache key is removed from the cache. If the user did not request
new data, then the cache is queried for data, and if any is found it is returned along with the cache object
and key, otherwise only the cache key and object are returned.

=head3 4: Creating the Cache object

	sub manage_cache {
		my $q      = shift;
		my $input  = shift;
		my $config = shift;
		my $cache_key = $input->{uri} . $input->{xsl};
		my $cached_file;
		my $c_handle = Cache::FileCache->new(
			{namespace   => $config->{namespace},
			 default_expires_in  => $config->{default_expire},
			 auto_purge_interval => $config->{auto_purge},
			 cache_depth         => $config->{cache_depth},
			 cache_root          => $config->{cache_root},
			 auto_purge_on_set   => 1
			} ) || tad ("Unable to create Cache object", $q);
		if ($input->{cache_status} eq "off") {
			$c_handle->remove($cache_key);
		} else {
			$cached_file = $c_handle->get($cache_key);
			$cached_file .= "\n<!-- Cached Fragment -->\n" if $cached_file &amp;&amp; $input->{debug};
		}
		return $c_handle, $cache_key, $cached_file;
	}

In listing B<5>, a C<XML::RSS::Tools> object is created. It is configured for no
conversion, and to use the HTTP client C<HTTP::Lite>. The XSL stylesheet is loaded first, then the
URI of the RSS feed is passed to the object. Finally transformation is performed, and the resultant XHTML
returned. If any process fails then a fatal error is raised via the C<tad> Terminate And Die method.

=head3 5: Processing the RSS Feed

	sub process_rss_feed{
		my $q      = shift;
		my $input  = shift;
		my $config = shift;
		my $rss = XML::RSS::Tools->new;
		$rss->set_version(0);
		$rss->set_http_client("lite");		# HTTP::GHTTP does not work on Windows/mod_Perl
		if (! $rss->xsl_file($config->{xsl_path} . $input->{xsl})) {tad ($rss->as_string('error'), $q)};
		print $q->comment("\nHTTP Client: " . $rss->get_http_client . "\n") if $input->{debug};
		if (! $rss->rss_uri($input->{uri})) {tad ($rss->as_string('error'), $q)};
		if ($rss->transform) {
			return $rss->as_string;
		} else {
			tad ($rss->as_string('error'), $q);
		}
	}

In listing B<6>, C<CGI.pm> is used to build the bottom of the page, and generate some
navigation buttons. Note the http://www.mozilla.org/ a C<view-source> URI prefix,
you may need to remove this if your browser cannot support this construct.

=head3 6: End the HTML

	sub end_fragment {
		my $q     = shift;
		my $input = shift;
		my $ref   = $q->referer() || "";
		my $self  = $q->self_url;
		print $q->hr, $q->start_div({-id => "navigation"});
		print $q->a({
			-href  => $ref,
			-title => "Click to Go Back"}, "Go Back"), " " if $ref;
		print $q->a({
			-href  => "view-source: " . $input->{uri},
			-title => "Click to See Source RSS Feed (Opens a New Window)",
			-target=> "_blank"}, "View RSS"), " ",
		      $q->a({
			-href  => "view-source:$self",
			-title => "View HTML Page Source"}, "View HTML"), " ";
		$self  .= ";cache=off" unless $self =~ /cache=off/;
		print $q->a({
			-href  => "$self",
			-title => "Reload RSS Feed From Source"}, "Refresh Feed"),
		      $q->end_div, $q->end_html;
	}

In listing B<7>, is a generic failure handler. Any error condition is reported by C<CGI::Carp> to the server
error logs, a helpful message is sent to the user, and the C<%ENV>
hash is cleaned up.

=head3 7: Something went wrong, report the error and clean up

	sub tad {
		my $error = shift || "Unknown Error";
		my $q     = shift;
		warn $error;
		print $q->hr, $q->h1("News 2 HTML Error:"), $q->h2($error), $q->hr, $q->end_html;
		%ENV = ();
		exit;
	}

=head2 See Also

L<CGI>, L<Apache::Registry>, L<Cache::FileCache>, L<CGI::Carp>, L<HTTP::Lite>