File Coverage

blib/lib/CPAN/Testers/WWW/Development.pm
Criterion Covered Total %
statement 33 105 31.4
branch 0 36 0.0
condition 0 19 0.0
subroutine 11 16 68.7
pod 3 3 100.0
total 47 179 26.2


line stmt bran cond sub pod time code
1             package CPAN::Testers::WWW::Development;
2              
3 5     5   63659 use warnings;
  5         6  
  5         142  
4 5     5   15 use strict;
  5         7  
  5         178  
5              
6             $|++;
7              
8             our $VERSION = '2.10';
9              
10             #----------------------------------------------------------------------------
11              
12             =head1 NAME
13              
14             CPAN::Testers::WWW::Development - The CPAN Testers Development website
15              
16             =head1 SYNOPSIS
17              
18             perl cpandevel-writepages
19              
20             This script calls this module as appropriate.
21              
22             =head1 DESCRIPTION
23              
24             Using the locations listed in the configuration file, calculates the file sizes
25             of the CPAN Testers databases, which should in the local directory, extracts
26             all the data into the components of each page. Then creates each HTML page for
27             the site.
28              
29             =cut
30              
31             # -------------------------------------
32             # Library Modules
33              
34 5     5   1953 use lib qw(./lib ../lib);
  5         2616  
  5         23  
35              
36 5     5   3415 use Config::IniFiles;
  5         111559  
  5         167  
37 5     5   36 use File::Basename;
  5         5  
  5         287  
38 5     5   2474 use File::Copy;
  5         7998  
  5         254  
39 5     5   25 use File::Path;
  5         7  
  5         207  
40 5     5   2785 use Getopt::ArgvFile default=>1;
  5         19019  
  5         28  
41 5     5   15631 use Getopt::Long;
  5         37817  
  5         21  
42 5     5   3399 use Number::Format qw(format_bytes);
  5         46045  
  5         348  
43 5     5   2134 use Template;
  5         69902  
  5         3773  
44              
45             # -------------------------------------
46             # Variables
47              
48             my (%options);
49              
50             $Number::Format::KILO_SUFFIX = ' KB';
51             $Number::Format::MEGA_SUFFIX = ' MB';
52             $Number::Format::GIGA_SUFFIX = ' GB';
53              
54             # -------------------------------------
55             # Program
56              
57             # -------------------------------------
58             # Subroutines
59              
60             =head1 FUNCTIONS
61              
62             =over 4
63              
64             =item main
65              
66             Main control routine. Calls init_options and make_pages.
67              
68             =item init_options
69              
70             Prepare command line options
71              
72             =item make_pages
73              
74             Create all the appropriate pages for the website.
75              
76             =cut
77              
78             sub main {
79 0     0 1   init_options();
80 0           make_pages();
81             }
82              
83             sub make_pages {
84 0     0 1   my %tvars;
85              
86 0           for($options{cfg}->Parameters('LOCATIONS')) {
87 0           my $source = $options{cfg}->val('LOCATIONS',$_);
88 0 0         $tvars{$_} = -f $source ? format_bytes((-s $source)) : 0;
89             }
90              
91 0           $tvars{VERSION} = $VERSION;
92              
93             my %config = ( # provide config info
94             RELATIVE => 1,
95             ABSOLUTE => 1,
96             INCLUDE_PATH => $options{templates},
97 0           INTERPOLATE => 0,
98             POST_CHOMP => 1,
99             TRIM => 1,
100             );
101              
102 0           my $target = $options{directory} . '/index.html';
103 0           my $parser = Template->new(\%config); # initialise parser
104 0 0         $parser->process('index.html',\%tvars,$target) # parse the template
105             or die $parser->error() . "\n";
106              
107 0           foreach my $filename (@{$options{tocopy}}) {
  0            
108 0           my $src = $options{templates} . "/$filename";
109 0 0         if(-f $src) {
110 0           my $dest = $options{directory} . "/$filename";
111 0           mkpath( dirname($dest) );
112 0 0         if(-d dirname($dest)) {
113 0           copy( $src, $dest );
114             } else {
115 0           warn "Missing directory: $dest\n";
116             }
117             } else {
118 0           warn "Missing file: $src\n";
119             }
120             }
121             }
122              
123             sub init_options {
124 0     0 1   GetOptions( \%options,
125             'config=s',
126             'templates=s',
127             'directory=s',
128             'logfile=s',
129             'logclean=i',
130             'help|h',
131             'version|v'
132             );
133              
134 0 0         _help(1) if($options{help});
135 0 0         _help(0) if($options{version});
136              
137             # ensure we have a configuration file
138 0 0         die "Must specify the configuration file\n" unless( $options{config});
139 0 0         die "Configuration file [$options{config}] not found\n" unless(-f $options{config});
140              
141             # load configuration file
142 0           local $SIG{'__WARN__'} = \&_alarm_handler;
143 0           eval { $options{cfg} = Config::IniFiles->new( -file => $options{config} ); };
  0            
144 0 0 0       die "Cannot load configuration file [$options{config}]: $@\n" unless($options{cfg} && !$@);
145              
146 0           my @TOCOPY = split("\n", $options{cfg}->val('TOCOPY','LIST'));
147 0           $options{tocopy} = \@TOCOPY;
148              
149 0   0       $options{templates} ||= $options{cfg}->val('MASTER','templates');
150 0   0       $options{directory} ||= $options{cfg}->val('MASTER','directory');
151 0   0       $options{logfile} ||= $options{cfg}->val('MASTER','logfile' );
152 0   0       $options{logclean} ||= $options{cfg}->val('MASTER','logclean' ) || 0;
      0        
153              
154 0   0       _log("$_=".($options{$_}|| '')) for(qw(templates logfile logclean directory));
155              
156 0 0         die "Must specify the output directory\n" unless( $options{directory});
157 0 0         die "Must specify the template directory\n" unless( $options{templates});
158 0 0         die "Template directory not found\n" unless(-d $options{templates});
159 0           mkpath($options{directory});
160 0 0         die "Could not create output directory\n" unless(-d $options{directory});
161             }
162              
163             # -------------------------------------
164             # Private Methods
165              
166             sub _help {
167 0     0     my $full = shift;
168              
169 0 0         if($full) {
170 0           print "\n";
171 0           print "Usage:$0 --config= \\\n";
172 0           print " [--logfile= [--logclean=<1|0>]] \\\n";
173 0           print " [--templates=] \\\n";
174 0           print " [--directory=] \\\n";
175 0           print " [--help|h] [--version|v] \n\n";
176              
177             # 12345678901234567890123456789012345678901234567890123456789012345678901234567890
178 0           print "This program builds the CPAN Testers Statistics website.\n";
179              
180 0           print "\nFunctional Options:\n";
181 0           print " [--config=] # path to config file [required]\n";
182 0           print " [--templates=] # path to templates\n";
183 0           print " [--directory=] # path to website directory\n";
184 0           print " [--logfile=] # path to logfile\n";
185 0           print " [--logclean] # overwrite log if specified\n";
186              
187 0           print "\nOther Options:\n";
188 0           print " [--version] # program version\n";
189 0           print " [--help] # this screen\n";
190              
191 0           print "\nFor further information type 'perldoc $0'\n";
192             }
193              
194 0           print "$0 v$VERSION\n";
195 0           exit(0);
196             }
197              
198             sub _log {
199 0 0   0     my $log = $options{logfile} or return;
200 0 0         mkpath(dirname($log)) unless(-f $log);
201              
202 0 0         my $mode = $options{logclean} ? 'w+' : 'a+';
203 0           $options{logclean} = 0;
204              
205 0           my @dt = localtime(time);
206 0           my $dt = sprintf "%04d/%02d/%02d %02d:%02d:%02d", $dt[5]+1900,$dt[4]+1,$dt[3],$dt[2],$dt[1],$dt[0];
207              
208 0 0         my $fh = IO::File->new($log,$mode) or die "Cannot write to log file [$log]: $!\n";
209 0           print $fh "$dt ", @_, "\n";
210 0           $fh->close;
211             }
212              
213             1;
214              
215             __END__