File Coverage

blib/lib/LCFG/Build/Skeleton.pm
Criterion Covered Total %
statement 25 27 92.5
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 34 36 94.4


line stmt bran cond sub pod time code
1             package LCFG::Build::Skeleton; # -*-perl-*-
2 1     1   820 use strict;
  1         1  
  1         41  
3 1     1   4 use warnings;
  1         2  
  1         48  
4              
5             # $Id: Skeleton.pm.in 15909 2011-02-17 18:00:05Z squinney@INF.ED.AC.UK $
6             # $Source: /var/cvs/dice/LCFG-Build-Skeleton/lib/LCFG/Build/Skeleton.pm.in,v $
7             # $Revision: 15909 $
8             # $HeadURL: https://svn.lcfg.org/svn/source/tags/LCFG-Build-Skeleton/LCFG_Build_Skeleton_0_3_1/lib/LCFG/Build/Skeleton.pm.in $
9             # $Date: 2011-02-17 18:00:05 +0000 (Thu, 17 Feb 2011) $
10              
11             our $VERSION = '0.3.1';
12              
13 1     1   541 use Email::Address ();
  1         34440  
  1         108  
14 1     1   1206 use Email::Valid ();
  1         128720  
  1         39  
15 1     1   11 use File::Basename ();
  1         2  
  1         21  
16 1     1   6 use File::Path ();
  1         2  
  1         18  
17 1     1   5 use File::Spec ();
  1         2  
  1         18  
18 1     1   1061 use File::Temp ();
  1         10249  
  1         24  
19 1     1   218 use LCFG::Build::PkgSpec ();
  0            
  0            
20             use List::MoreUtils qw(none);
21             use Sys::Hostname ();
22             use Template ();
23             use UNIVERSAL::require;
24             use YAML::Syck ();
25              
26             my $TMPLDIR
27             = exists $ENV{LCFG_BUILD_TMPLDIR}
28             ? $ENV{LCFG_BUILD_TMPLDIR}
29             : '/usr/share/lcfgbuild/templates';
30              
31             use Moose;
32             use Moose::Util::TypeConstraints;
33              
34             with 'MooseX::Getopt';
35              
36             subtype 'LCFG::Types::ComponentName'
37             => as 'Str'
38             => where { m/^[A-Za-z][A-Za-z0-9_]+$/ };
39              
40             subtype 'LCFG::Types::EmailAddress'
41             => as 'Str'
42             => where { Email::Valid->address( -address => $_ ) }
43             => message { "Address ($_) for report must be a valid email address" };
44              
45             subtype 'LCFG::Types::Response'
46             => as 'Str'
47             => where { $_ eq 'yes' || $_ eq 'no' };
48              
49             coerce 'LCFG::Types::Response' => from 'Str' =>
50             via { $_ && ( $_ eq '1' || m/^ye(s|p|ah)!?$/i ) ? 'yes' : 'no' };
51              
52             MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
53             'LCFG::Types::Response' => q{!}, );
54              
55             has 'configfile' => (
56             is => 'ro',
57             isa => 'Str',
58             default => sub { File::Spec->catfile( $ENV{HOME}, '.lcfg',
59             'skeleton', 'defaults.yml' ) },
60             predicate => 'has_configfile',
61             documentation => 'Where defaults should be stored',
62             );
63              
64             has 'tmpldir' => (
65             is => 'ro',
66             isa => 'Str',
67             default => sub { File::Spec->catdir( $ENV{HOME}, '.lcfg',
68             'skeleton', 'templates' ) },
69             documentation => 'Local templates directory',
70             );
71              
72             has 'usage' => (
73             metaclass => 'NoGetopt',
74             is => 'ro',
75             isa => 'Str',
76             );
77              
78             has 'help' => (
79             is => 'ro',
80             isa => 'Bool',
81             default => 0,
82             documentation => 'Display the help text',
83             );
84              
85             has 'name' => (
86             is => 'rw',
87             isa => 'LCFG::Types::ComponentName',
88             documentation => 'Name of the project',
89             );
90              
91             has 'abstract' => (
92             is => 'rw',
93             isa => 'Str',
94             lazy => 1,
95             documentation => 'Short description of the project',
96             default => sub {
97             $_[0]->lcfg_component eq 'yes'
98             ? 'The LCFG ' . $_[0]->name . ' component'
99             : q{};
100             },
101             );
102              
103             has 'author_name' => (
104             is => 'rw',
105             isa => 'Str',
106             default => sub { ( getpwuid $< )[6] },
107             documentation => 'Name of the author',
108             );
109              
110             has 'author_email' => (
111             is => 'rw',
112             isa => 'LCFG::Types::EmailAddress',
113             builder => '_default_email',
114             documentation => 'Email address for the author',
115             );
116              
117             sub _default_email {
118              
119             my $email;
120             if ( $ENV{EMAIL} ) {
121             $email = $ENV{EMAIL};
122             } else {
123             my $username = ( getpwuid $< )[0];
124              
125             my ( $hostname, @domain ) = split /\./, Sys::Hostname::hostname;
126              
127             my $domain = join q{.}, @domain;
128             $email = join q{@}, $username, $domain;
129             }
130              
131             return $email;
132             }
133              
134             has 'lang' => (
135             is => 'rw',
136             isa => enum( [qw/perl shell/] ),
137             documentation => 'Language for component (perl/shell)',
138             default => 'perl',
139             );
140              
141             has 'vcs' => (
142             is => 'rw',
143             isa => enum( [qw/SVN CVS None/] ),
144             documentation => 'Version Control System (SVN/CVS/None)',
145             default => 'CVS',
146             );
147              
148             has 'platforms' => (
149             is => 'rw',
150             isa => 'Maybe[Str]',
151             documentation => 'Supported platforms',
152             );
153              
154             has 'license' => (
155             is => 'rw',
156             isa => 'Str',
157             documentation => 'Distribution license',
158             default => 'GPLv2',
159             );
160              
161             has 'restart' => (
162             is => 'rw',
163             isa => 'LCFG::Types::Response',
164             coerce => 1,
165             documentation => 'Restart component on RPM update (yes/no)',
166             default => 'yes',
167             );
168              
169             has 'gencmake' => (
170             is => 'rw',
171             isa => 'LCFG::Types::Response',
172             coerce => 1,
173             documentation => 'Use the CMake build system (yes/no)',
174             default => 'yes',
175             );
176              
177             has 'genchangelog' => (
178             is => 'rw',
179             isa => 'LCFG::Types::Response',
180             coerce => 1,
181             documentation => 'Generate the ChangeLog from the Revision-Control log? (yes/no)',
182             default => 'no',
183             );
184              
185             has 'checkcommitted' => (
186             is => 'rw',
187             isa => 'LCFG::Types::Response',
188             coerce => 1,
189             documentation => 'Check all changes are committed before a release? (yes/no)',
190             default => 'yes',
191             );
192              
193             has 'lcfg_component' => (
194             is => 'rw',
195             isa => 'LCFG::Types::Response',
196             coerce => 1,
197             documentation => 'Is this an LCFG component? (yes/no)',
198             default => 'yes',
199             );
200              
201             has 'interactive' => (
202             is => 'ro',
203             isa => 'Bool',
204             documentation => 'Interactively query the user',
205             default => 1,
206             );
207              
208             has 'force' => (
209             is => 'ro',
210             isa => 'Bool',
211             documentation => 'Forceably remove an old project directory',
212             default => 0,
213             );
214              
215             sub get_config_from_file {
216             my ( $self, $file ) = @_;
217              
218             my $cfg = {};
219             if ( -f $file ) {
220             $cfg = YAML::Syck::LoadFile($file);
221             }
222              
223             return $cfg;
224             }
225              
226             # The code for new_with_options() is mostly stolen from
227             # MooseX::Getopt. It has modifications to allow us to ignore the need
228             # to check for a MooseX::ConfigFromFile role. That module just pulls
229             # in far too many extra dependencies for our fairly small
230             # requirements. This code also handles the default value for the
231             # configfile being a code-reference.
232              
233             sub new_with_options {
234             my ( $class, @params ) = @_;
235              
236             my $config_from_file;
237             {
238             local @ARGV = @ARGV;
239              
240             my $configfile;
241             my $opt_parser
242             = Getopt::Long::Parser->new( config => [qw(pass_through)] );
243              
244             $opt_parser->getoptions( 'configfile=s' => \$configfile );
245              
246             if ( !defined $configfile ) {
247             my $cfmeta = $class->meta->find_attribute_by_name('configfile');
248             if ( $cfmeta->has_default ) {
249             $configfile = $cfmeta->default;
250             }
251             if ( 'CODE' eq ref $configfile ) {
252             $configfile = $configfile->();
253             }
254             }
255              
256             if ( defined $configfile ) {
257             $config_from_file = $class->get_config_from_file($configfile);
258             }
259              
260             }
261              
262             my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
263              
264             if ( ref $constructor_params ne 'HASH' ) {
265             die "Single parameters to new_with_options() must be a HASH ref\n";
266             }
267              
268             my %processed = $class->_parse_argv(
269             options => [ $class->_attrs_to_options($config_from_file) ],
270             params => $constructor_params,
271             );
272              
273             my $params
274             = $config_from_file
275             ? { %{$config_from_file}, %{ $processed{params} } }
276             : $processed{params};
277              
278             return $class->new(
279             ARGV => $processed{argv_copy},
280             extra_argv => $processed{argv},
281             usage => "$processed{usage}", # stringify immediately
282             @params, # explicit params to ->new
283             %{$params}, # params from CLI
284             );
285              
286             }
287              
288             my @questions = qw(
289             name
290             lcfg_component
291             abstract
292             author_name
293             author_email
294             lang
295             vcs
296             platforms
297             license
298             restart
299             gencmake
300             checkcommitted
301             genchangelog
302             );
303              
304             sub store_answers {
305             my ($self) = @_;
306              
307             my @ignore = qw(name lcfg_component abstract);
308             my @extra = qw(tmpldir);
309              
310             my %store;
311             for my $question ( @questions, @extra ) {
312             if ( none { $question eq $_ } @ignore ) {
313             $store{$question} = $self->$question;
314             }
315             }
316              
317             my $cfg = $self->configfile;
318              
319             my ( $name, $path ) = File::Basename::fileparse($cfg);
320             if ( !-d $path ) {
321             eval { File::Path::mkpath($path) };
322             if ($@) {
323             die "Failed to create directory, $cfg: $!\n";
324             }
325             }
326              
327             YAML::Syck::DumpFile( $cfg, \%store );
328              
329             return;
330             }
331              
332             sub query_user {
333             my ($self) = @_;
334              
335             if ( $self->interactive ) {
336             for my $question (@questions) {
337              
338             my $doc = $self->meta->get_attribute($question)->documentation;
339              
340             my $default = $self->$question;
341              
342             my $defstring = q{};
343             if ( defined $default ) {
344             $defstring = ' [' . $default . ']';
345             }
346              
347             while (1) {
348             print $doc . $defstring . q{: };
349             chomp( my $answer = <STDIN> );
350              
351             # trim any whitespace from the response
352             $answer =~ s/^\s+//;
353             $answer =~ s/\s+$//;
354              
355             if ( length $answer > 0 ) {
356             eval { $self->$question($answer) };
357             }
358              
359             if ($@) {
360             print "Error: Bad choice, please try again.\n";
361             } else {
362             last;
363             }
364              
365             }
366             }
367             }
368              
369             # always store the answers as they may have come from the command line
370             $self->store_answers;
371              
372             return;
373             }
374              
375             sub create_package {
376             my ($self) = @_;
377              
378             # Make an attempt to sanitise whatever the user gave us as an
379             # email address.
380              
381             my ($addr) = Email::Address->parse($self->author_email);
382              
383             my $new_addr = Email::Address->new( $self->author_name,
384             $addr->address );
385             my $author = $new_addr->format;
386              
387             my @platforms;
388             if ( $self->platforms ) {
389             @platforms = split /\s*,\s*/, $self->platforms;
390             }
391              
392             # Sometimes people mistakenly put a 'lcfg-' prefix on the name.
393             my $name = $self->name;
394             if ( $self->lcfg_component eq 'yes' ) {
395             $name =~ s/^lcfg-//;
396             }
397              
398             my $pkgspec = LCFG::Build::PkgSpec->new(
399             name => $name,
400             version => '0.0.1',
401             release => '1',
402             author => [$author],
403             abstract => $self->abstract,
404             license => $self->license,
405             translate => ['*.cin'],
406             platforms => [@platforms],
407             );
408              
409             if ( $self->lcfg_component eq 'yes' ) {
410             $pkgspec->schema(1);
411             $pkgspec->base('lcfg');
412             $pkgspec->group('LCFG');
413             }
414              
415             my $localdir = $pkgspec->fullname;
416             if ( -e $localdir ) {
417             die "There is already a local directory or file named \"$localdir\".\n Please move it aside and try again\n";
418             }
419              
420             if ( $self->gencmake eq 'yes' ) {
421             $pkgspec->set_buildinfo( gencmake => 1 );
422             }
423             else { # not essential but good to be explicit here
424             $pkgspec->set_buildinfo( gencmake => 0 );
425             }
426              
427             # version control information
428              
429             $pkgspec->set_vcsinfo( logname => 'ChangeLog' );
430              
431             if ( $self->checkcommitted eq 'yes' ) {
432             $pkgspec->set_vcsinfo( checkcommitted => 1 );
433             }
434             if ( $self->genchangelog eq 'yes' ) {
435             $pkgspec->set_vcsinfo( genchangelog => 1 );
436             }
437              
438             my $tempdir = File::Temp::tempdir( CLEANUP => 1 );
439              
440             my $new_metafile = File::Spec->catfile( $tempdir, 'lcfg.yml' );
441             $pkgspec->metafile($new_metafile);
442             $pkgspec->save_metafile();
443              
444             print "Stored LCFG build metadata\n";
445              
446             my @include;
447             if ( -d $self->tmpldir ) {
448             push @include, $self->tmpldir;
449             }
450             push @include, $TMPLDIR;
451              
452             my $tt = Template->new(
453             { INCLUDE_PATH => \@include,
454             FILTERS => { to_bool => sub { $_ eq 'yes' ? 1 : 0 }, },
455             PRE_CHOMP => 1,
456             }
457             ) or die $Template::ERROR;
458              
459             # Key is the template filename
460             # Value is the target file path stored as a ref to a list of parts
461              
462             my %files = (
463             'specfile.tt' => ['specfile'],
464             'ChangeLog.tt' => ['ChangeLog'],
465             'README.BUILD.tt' => ['README.BUILD'],
466             'README.tt' => ['README'],
467             );
468              
469             my @exefiles;
470              
471             if ( $self->lcfg_component eq 'yes' ) {
472             my $comp = $pkgspec->name;
473              
474             if ( $self->lang eq 'perl' ) {
475             $files{'COMPONENT.pl.tt'} = ["$comp.cin"];
476             }
477             else {
478             $files{'COMPONENT.sh.tt'} = ["$comp.cin"];
479             }
480             push @exefiles, "$comp.cin";
481              
482             $files{'COMPONENT.def.tt'} = ["$comp.def.cin"];
483             $files{'COMPONENT.pod.tt'} = ["$comp.pod.cin"];
484              
485             my $nagios_dir = File::Spec->catdir( $tempdir, 'nagios' );
486             mkdir $nagios_dir
487             or die "Could not create nagios directory, $nagios_dir: $!\n";
488              
489             $files{'README.nagios.tt'} = [ 'nagios', 'README' ];
490              
491             my $templates_dir = File::Spec->catdir( $tempdir, 'templates' );
492             mkdir $templates_dir
493             or die "Could not create templates directory, $templates_dir: $!\n";
494              
495             $files{'README.templates.tt'} = [ 'templates', 'README' ];
496             }
497              
498             for my $template ( keys %files ) {
499              
500             my @file = @{$files{$template}};
501             my $output = File::Spec->catfile( $tempdir, @file );
502              
503             print "Generating $output\n";
504             $tt->process(
505             $template,
506             { skel => $self,
507             pkgspec => $pkgspec,
508             },
509             $output
510             ) or warn $tt->error();
511             }
512              
513             for my $exe (@exefiles) {
514             my $path = File::Spec->catfile( $tempdir, $exe );
515             chmod 0755, $path;
516             }
517              
518             if ( $self->lang eq 'perl' ) {
519             my $testdir = File::Spec->catdir( $tempdir, 't' );
520             mkdir $testdir
521             or die "Could not create tests directory, $testdir: $!\n";
522             }
523              
524             eval {
525             my $vcsmodule = 'LCFG::Build::VCS::' . $self->vcs;
526              
527             $vcsmodule->require or die $@;
528              
529             my $vcs = $vcsmodule->new(
530             quiet => 0,
531             dryrun => 0,
532             module => $pkgspec->fullname,
533             );
534              
535             $vcs->import_project( $tempdir, $pkgspec->version,
536             'Created with lcfg-skeleton' );
537              
538             $vcs->checkout_project();
539              
540             };
541              
542             if ($@) {
543             die "Failed to import project to your chosen version-control system:\n $@\n";
544             }
545              
546             print "Successfully imported your project into your version-control system.\n";
547              
548             return $pkgspec;
549             }
550              
551             1;
552             __END__
553              
554             =head1 NAME
555              
556             LCFG::Build::Skeleton - LCFG software package generator
557              
558             =head1 VERSION
559              
560             This documentation refers to LCFG::Build::Skeleton version 0.3.1
561              
562             =head1 SYNOPSIS
563              
564             my $skel = LCFG::Build::Skeleton->new_with_options();
565              
566             $skel->query_user();
567              
568             $skel->create_package();
569              
570             =head1 DESCRIPTION
571              
572             This module handles the creation of the skeleton of an LCFG software
573             project. Typically, it prompts the user to answer a set of standard
574             questions and then generates the necessary files from a set of
575             templates. These generated files include the necessary metadata, build
576             files and, for LCFG components, example code. It can also add the new
577             project into the revision-control system of choice.
578              
579             =head1 ATTRIBUTES
580              
581             If using the new_with_options() method then any of the attributes can
582             be set from the commandline (or, more precisely, via the @ARGV
583             list). An attribute named C<foo> is accessible as the commandline
584             option C<--foo>. If it is a boolean value then the module will also
585             support the C<--no-foo> form to turn off a feature
586             (e.g. --no-gencmake).
587              
588             =over 4
589              
590             =item name
591              
592             The name of the project. Note that in the case of an LCFG component
593             this should be C<foo> B<NOT> C<lcfg-foo>.
594              
595             =item abstract
596              
597             A short description of the project. If this is an LCFG component the
598             default value suggested to the user is "The LCFG $name component".
599              
600             =item author_name
601              
602             The name of the author (i.e you!). The default is the string stored in
603             the gecos field of the passwd entry.
604              
605             =item author_email
606              
607             The email address for the author. The default is built from the
608             current username and domain name.
609              
610             =item lcfg_component
611              
612             This controls whether the generated project is an LCFG component. This
613             is a yes/no answer and it defaults to "yes" (it is handled in the same
614             way as a boolean value on the command line).
615              
616             =item lang
617              
618             The language which will be used, this is either "perl" or
619             "shell". This only really has an affect if you are creating an LCFG
620             component.
621              
622             =item vcs
623              
624             Which revision-control system you intend to use for the
625             project. Currently only "CVS" and "None" are supported. You will need
626             the relevant LCFG::Build::VCS helper module installed for this to
627             work.
628              
629             =item platforms
630              
631             The comma-separate list of platforms which are supported by this code
632             (e.g. ScientificLinux5).
633              
634             =item license
635              
636             The license under which the source code can be distributed. This
637             defaults to "GPLv2".
638              
639             =item restart
640              
641             This controls whether, if this is an LCFG component, should it be
642             restarted after package upgrade if the component is already
643             running. This is a yes/no answer and it defaults to "yes" (it is
644             handled in the same way as a boolean value on the command line).
645              
646             =item gencmake
647              
648             This controls whether the LCFG CMake infrastructure will be used to
649             build the project. This is a yes/no answer and it defaults to "yes"
650             (it is handled in the same way as a boolean value on the command
651             line).
652              
653             =item genchangelog
654              
655             This controls whether or not to generate the project changelog from
656             the revision-control commit logs. This is a yes/no answer and it
657             defaults to "no" (it is handled in the same way as a boolean value on
658             the command line).
659              
660             =item checkcommitted
661              
662             This controls whether the revision-control tools should check that all
663             files are committed before making a new release. This is a yes/no
664             answer and it defaults to "yes" (it is handled in the same way as a
665             boolean value on the command line).
666              
667             =item interactive
668              
669             This controls whether the L<query_user()> method will actually interact with the user or just store the values taken from the defaults file and any commandline options. This is a boolean value which defaults to false (zero).
670              
671             =item force
672              
673             This controls whether an existing project directory will be removed if the name matches that required for the new skeleton project. This is a boolean value which defaults to false (zero).
674              
675             =item configfile
676              
677             This is the configuration file which is used to store the defaults
678             between calls to the lcfg-skeleton tool. Normally you should not need
679             to modify this and it defaults to C<~/.lcfg/skeleton/defaults.yml>.
680              
681             =item tmpldir
682              
683             This is the directory into which local versions of templates should be
684             placed. Normally you should not need to modify this and it defaults to
685             C<~/.lcfg/skeleton/templates/>. For reference, the standard templates
686             are normally stored in C</usr/share/lcfgbuild/templates>.
687              
688             =back
689              
690              
691             =head1 SUBROUTINES/METHODS
692              
693             =over 4
694              
695             =item new(%hash_of_options)
696              
697             Creates a new object of the LCFG::Build::Skeleton class. Values for
698             any attribute can be specified in the hash of options.
699              
700             =item new_with_options(%hash_of_options)
701              
702             Creates a new object of the LCFG::Build::Skeleton class and if any
703             attribute values were specified on the command line those will be set
704             in the returned instance. Values for any attribute can be specified in
705             the hash of options.
706              
707             =item query_user()
708              
709             This prompts the user to answer a set of standard questions (except
710             when the C<interactive> option is set to false) and stores the answer
711             in the object attributes. If an invalid value is given the user will
712             be prompted again. For convenience, the answers are also stored in a
713             file and used as the defaults in the next run of the command. The
714             default value is shown in the prompt between square-brackets and just
715             pressing return is enough to accept the default.
716              
717             =item create_package()
718              
719             This uses the skeleton object attribute values to generate the
720             skeleton tree of files for the new project. If a project directory of
721             the desired name already exists you will need to move it aside, choose
722             a different project name or set the C<force> attribute to true.
723              
724             =item store_answers()
725              
726             This is primarily intended for internal usage. It will store the
727             values of the answers given be the user (except the project name and
728             abstract) so that they can be used as defaults in future calls to the
729             lcfg-skeleton command. The default values are stored in the file name
730             specified in the C<configfile> attribute, that defaults to
731             C<~/lcfg/skeleton/defaults.yml>
732              
733             =item get_config_from_file($filename)
734              
735             This is primarily intended for internal usage. This retrieves the
736             configuration data from the specified file, which must be in YAML
737             format, and returns it as a reference to a hash.
738              
739             =back
740              
741             =head1 CONFIGURATION AND ENVIRONMENT
742              
743             The default values for the answers are stored in the file referred to
744             in the C<configfile> attribute. This is normally
745             C<~/.lcfg/skeleton/defaults.yml> but that can be overridden by the
746             user. If the file does not exist it will be created when this tool is
747             first run.
748              
749             It is possible to override any of the standard templates used to
750             generate the skeleton project by placing your own version into the
751             directory referred to in the C<tmpldir> attribute. This is normally
752             C<~/.lcfg/skeleton/templates/> but that can be overridden by the
753             user. For reference, the standard templates are normally stored in
754             C</usr/share/lcfgbuild/templates>.
755              
756             =head1 DEPENDENCIES
757              
758             This module is L<Moose> powered and uses L<MooseX::Getopt> to provide
759             a new_with_options() method for creating new instances from the
760             options specified in @ARGV (typically via the commandline). The
761             L<YAML::Syck> module is used to parse the file which holds the default
762             values for the answers. You will also need the L<List::MoreUtils> and
763             L<UNIVERSAL::require> modules.
764              
765             The Perl Template Toolkit is required to generate the files for the
766             skeleton project.
767              
768             The following LCFG Build Tools modules are also required:
769             L<LCFG::Build::PkgSpec>(3), L<LCFG::Build::VCS>(3) and VCS helper modules.
770              
771             =head1 SEE ALSO
772              
773             L<LCFG::Build::Tools>, lcfg-skeleton(1), lcfg-reltool(1)
774              
775             =head1 PLATFORMS
776              
777             This is the list of platforms on which we have tested this
778             software. We expect this software to work on any Unix-like platform
779             which is supported by Perl.
780              
781             FedoraCore5, Fedora6, ScientificLinux5
782              
783             =head1 BUGS AND LIMITATIONS
784              
785             There are no known bugs in this application. Please report any
786             problems to bugs@lcfg.org, feedback and patches are also always very
787             welcome.
788              
789             =head1 AUTHOR
790              
791             Stephen Quinney <squinney@inf.ed.ac.uk>
792              
793             =head1 LICENSE AND COPYRIGHT
794              
795             Copyright (C) 2008 University of Edinburgh
796              
797             This library is free software; you can redistribute it and/or modify
798             it under the terms of the GPL, version 2 or later.
799              
800             =cut