#! /usr/bin/perl -w use strict; $| = 1; # $Id$ use vars qw( $VERSION ); $VERSION = '0.005'; use Cwd; use File::Path; use File::Copy; use File::Spec::Functions; use FindBin; use lib $FindBin::Bin; use lib catdir( $FindBin::Bin, 'lib' ); use lib catdir( $FindBin::Bin, updir(), 'lib' ); use Test::Smoke; use Test::Smoke::Util qw( get_patch do_pod2usage ); my $myusage = "Usage: $0 -d -a -l [options]"; use Getopt::Long; my %opt = ( ddir => undef, adir => undef, lfile => undef, force => undef, v => undef, config => undef, help => 0, man => 0, ); =head1 NAME archiverpt.pl - Patch the sourcetree =head1 SYNOPSIS $ ./archiverpt.pl -a archive -d ../perl-current -l smokecurrent.log or $ ./patchtree.pl -c [smokecurrent_config] =head1 OPTIONS =over 4 =item * B -c | --config Use the settings from the configfile F can use the configuration file created by F. Other options can override the settings from the configuration file. =item * B -d | --ddir Set the directory for the source-tree (cwd) -a | --adir Set the direcory for the archive -l | --lfile Set the (optional) logfile --[no]force Overwrite existsing archives -v | --verbose <0..2> Set verbose level -h | --help Show help message (needs Pod::Usage) --man Show the perldoc (needs Pod::Usage) =back =head1 DESCRIPTION This is a small program that archives the smokereport and logfile like: report -> /rpt.rpt logfile -> /log.log =cut GetOptions( \%opt, 'adir|a=s', 'ddir|d=s', 'lfile|l=s', 'force!', 'v|verbose=i', 'help|h', 'man', 'config|c:s', ) or do_pod2usage( verbose => 1, myusage => $myusage ); $opt{ man} and do_pod2usage( verbose => 2, exitval => 0, myusage => $myusage ); $opt{help} and do_pod2usage( verbose => 1, exitval => 0, myusage => $myusage ); if ( defined $opt{config} ) { $opt{config} eq "" and $opt{config} = 'smokecurrent_config'; read_config( $opt{config} ) or do { my $config_name = File::Spec->catfile( $FindBin::Bin, $opt{config} ); read_config( $config_name ); }; unless ( Test::Smoke->config_error ) { foreach my $option ( keys %opt ) { next if defined $opt{ $option }; if ( $option eq 'type' ) { $opt{type} ||= $conf->{patch_type}; } elsif ( exists $conf->{ $option } ) { $opt{ $option } ||= $conf->{ $option } } } } else { warn "WARNING: Could not process '$opt{config}': " . Test::Smoke->config_error . "\n"; } } $opt{ddir} && -d $opt{ddir} or do_pod2usage(verbose => 0, myusage => $myusage); $opt{adir} && -d $opt{adir} or do { mkpath( $opt{adir}, 0, 0775 ) or die "Cannot create '$opt{adir}': $!"; }; my $patch_level = get_patch( $opt{ddir} )->[0]; $patch_level =~ tr/ //sd; SKIP_RPT: { my $archived_rpt = catfile( $opt{adir}, "rpt${patch_level}.rpt" ); # Do not archive if it is already done last SKIP_RPT if -f $archived_rpt && !$opt{force}; my $mktest_rpt = catfile( $opt{ddir}, 'mktest.rpt' ); if ( -f $mktest_rpt ) { copy( $mktest_rpt, $archived_rpt ) or die "Cannot copy to '$archived_rpt': $!"; } } SKIP_OUT: { my $archived_out = catfile( $opt{adir}, "out${patch_level}.out" ); # Do not archive if it is already done last SKIP_OUT if -f $archived_out && !$opt{force}; my $mktest_out = catfile( $opt{ddir}, 'mktest.out' ); if ( -f $mktest_out ) { copy( $mktest_out, $archived_out ) or die "Cannot copy to '$archived_out': $!"; } } SKIP_LOG: { my $archived_log = "log${patch_level}.log"; unless ( defined $opt{lfile} ) { $opt{v} and print "No logfile defined!\n"; last SKIP_LOG; } unless ( -f $opt{lfile} ) { $opt{v} and print "Logfile '$opt{lfile}' not found!\n"; last SKIP_LOG; } copy( $opt{lfile}, File::Spec->catfile( $opt{adir}, $archived_log ) ) or die "Cannot copy to '$archived_log': $!"; } =head1 COPYRIGHT (c) 2002-2003, All rights reserved. * Abe Timmerman This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See: =over 4 item * L item * L =back This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut