#!/usr/bin/perl use strict; use warnings; use vars qw($VERSION); $VERSION = '0.01'; #---------------------------------------------------------------------------- =head1 NAME updates.pl - template generator for the blog updates. =head1 SYNOPSIS perl updates.pl =head1 DESCRIPTION The CPAN Testers Statistics site regular features monthly blog updates. Previously these were added to the templates by hand and included in the code tarball that was published on the site. However, as the data files are now being released separately, this script allows the templates relating to the blog updates to be generated once the latest data files have been updated. =cut # ------------------------------------- # Pre-Loading BEGIN { my $syck_loaded = 0; eval { require YAML::Syck; eval "use YAML::Syck qw(Load LoadFile)"; $syck_loaded = 1; }; if(!$syck_loaded) { require YAML; eval "use YAML qw(Load LoadFile)"; } } # ------------------------------------- # Library Modules use Getopt::Long; use HTML::Entities qw(decode_entities encode_entities_numeric); use Template; use Time::Piece; # ------------------------------------- # Variables use constant TEMPLATES => './templates'; use constant UPDATES => 'data/updates.yml'; my (%options); # ------------------------------------- # Program init_options(); my $content = LoadFile($options{updates}); make_file($content, 1,'updates-index.tt','updates-index.html'); make_file($content,-1,'updates-all.tt','updates-all.html'); make_file($content,10,'updates-rss.tt','rss-2.0.xml'); # ------------------------------------- # Subroutines =head1 FUNCTIONS =over 4 =item make_file =cut sub make_file { my ($yml,$cnt,$source,$target) = @_; my $src = "$options{templates}/$source"; my $out = "$options{templates}/$target"; unless(-f $src) { print STDERR "Cannot access file [$src]\n"; return; } my @updates; for my $update (@{$content->{updates}}) { last if($cnt == 0); $cnt--; $update->{Content} =~ s/^\s*<\s+//s; if($target =~ /\.xml$/) { my $string = decode_entities( $update->{Content} ); $update->{Content} = encode_entities_numeric( $string ); } push @updates, $update; } #Wed, 20 Aug 2008 15:05:22 UT my $tp = localtime; my $builddate = sprintf "%s, %d %s %04d %02d:%02d:%02d UT", $tp->wdayname, $tp->mday, $tp->monname, $tp->year, $tp->hour, $tp->min, $tp->sec; my %vars = ( updates => \@updates, builddate => $builddate, ); my %config = ( # provide config info RELATIVE => 1, ABSOLUTE => 1, INCLUDE_PATH => $options{templates}, INTERPOLATE => 0, POST_CHOMP => 1, TRIM => 1, ); my $parser = Template->new(\%config); # initialise parser $parser->process($src,\%vars,$out) # parse the template or die $parser->error(); } =item init_options Prepare command line options =cut sub init_options { GetOptions( \%options, 'templates|t=s', 'updates|u=s', 'help|h', 'version|V' ); _help(1) if($options{help}); _help(0) if($options{version}); # use defaults if none provided $options{templates} ||= TEMPLATES; $options{updates} ||= UPDATES; if($options{templates} && ! -d $options{templates}) { print "\nERROR: Given templates directory [$options{templates}] not valid, see help below.\n"; _help(1); } if($options{updates} && ! -f $options{updates}) { print "\nERROR: Given updates data file [$options{updates}] not a valid file, see help below.\n"; _help(1); } } sub _help { my $full = shift; if($full) { print "\n"; print "Usage:$0 [--help|h] [--version|V] \\\n"; print " [--templates|t=<dir>] \\\n"; print " [--updates|u=<file>] \n\n"; # 12345678901234567890123456789012345678901234567890123456789012345678901234567890 print "This program builds the CPAN Testers Statistics RSS feed and templates.\n"; print "\nFunctional Options:\n"; print " [--templates=<dir>] # path to templates directory\n"; print " [--updates=<file>] # path/file to updates YAML file\n"; print "\nOther Options:\n"; print " [--version] # program version\n"; print " [--help] # this screen\n"; print "\nFor further information type 'perldoc $0'\n"; } print "$0 v$VERSION\n\n"; exit(0); } __END__ =back =head1 BUGS, PATCHES & FIXES There are no known bugs at the time of this release. However, if you spot a bug or are experiencing difficulties, that is not explained within the POD documentation, please send bug reports and patches to the RT Queue (see below). Fixes are dependant upon their severity and my availablity. Should a fix not be forthcoming, please feel free to (politely) remind me. RT Queue - http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Testers-WWW-Statistics =head1 SEE ALSO L<CPAN::WWW::Testers::Generator>, L<CPAN::WWW::Testers> F<http://www.cpantesters.org/>, F<http://stats.cpantesters.org/> =head1 AUTHOR Barbie, <barbie@cpan.org> for Miss Barbell Productions <http://www.missbarbell.co.uk>. =head1 COPYRIGHT AND LICENSE Copyright (C) 2008 Barbie for Miss Barbell Productions. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut