From c731dfc56e405ccb0bbdbe4f8bbc15f1a6f014a2 Mon Sep 17 00:00:00 2001 From: Flavio Poletti Date: Sat, 10 Aug 2013 20:31:02 +0200 Subject: [PATCH] made test more rational --- t/01/Makefile | 12 +- t/01/test.pl | 405 ---------------------------------------------------------- 2 files changed, 7 insertions(+), 410 deletions(-) delete mode 100755 t/01/test.pl diff --git a/t/01/Makefile b/t/01/Makefile index 76e5060..7773018 100644 --- a/t/01/Makefile +++ b/t/01/Makefile @@ -1,4 +1,4 @@ -all: +compile: ../../deployable --output test.pl --bundle --bzip2 \ hello.sh \ --rootdir rootdir_1 \ @@ -6,6 +6,8 @@ all: --root root_1 \ --root root_2 +test: check clean + extract: rm -rf prova mkdir -p prova/root prova/here @@ -14,10 +16,10 @@ extract: ./test.pl --root-tar | ( cd prova/root ; tar xvjf - ) cd prova/root && ls -R > ../root.list -test: all extract +clean: + rm -rf prova test.pl + +check: compile extract diff here.list prova/here.list diff root.list prova/root.list echo -e "\nall tests successful" - -clean: - rm -rf prova diff --git a/t/01/test.pl b/t/01/test.pl deleted file mode 100755 index b2f74aa..0000000 --- a/t/01/test.pl +++ /dev/null @@ -1,405 +0,0 @@ -#!/usr/bin/env perl -# *** NOTE *** LEAVE THIS MODULE LIST AS A PARAGRAPH -use strict; -use warnings; -use 5.006_002; -our $VERSION = '0.0.3'; -use English qw( -no_match_vars ); -use Fatal qw( close chdir opendir closedir ); -use File::Temp qw( tempdir ); -use File::Path qw( mkpath ); -use File::Spec::Functions qw( file_name_is_absolute catfile ); -use File::Basename qw( dirname ); -use POSIX qw( strftime ); -use Getopt::Long qw( :config gnu_getopt ); -use Cwd qw( getcwd ); -use Fcntl qw( :seek ); - -# *** NOTE *** LEAVE EMPTY LINE ABOVE - -my %default_config = ( # default values - workdir => '/tmp/our-deploy', - cleanup => 1, - deploy => 1, - tempdir => 1, -); -my %config; -GetOptions( - \%config, - qw( - usage|help|man! - version! - - bundle|all-exec|X! - cleanup|c! - deploy! - dryrun|dry-run|n! - filelist|list|l! - heretar|here-tar|H! - inspect|i=s - no-tar! - roottar|root-tar|R! - show|show-options|s! - tar|t=s - tempdir! - workdir|work-directory|deploy-directory|w=s - ), -); - -usage() if $config{usage}; -version() if $config{version}; - -my $DATA_POSITION = tell DATA; - -my $tar; # FIXME -my $TAR_PACKAGE; # FIXME - -if ($config{roottar}) { - binmode STDOUT; - my ($fh, $size) = locate_file('root'); - copy($fh, \*STDOUT, $size); - exit 0; -} ## end if ($config{roottar}) - -if ($config{heretar}) { - binmode STDOUT; - my ($fh, $size) = locate_file('here'); - copy($fh, \*STDOUT, $size); - exit 0; -} ## end if ($config{heretar}) - -if ($config{filelist}) { - my $root_tar = get_sub_tar('root'); - print "root:\n"; - $root_tar->print_filelist(); - my $here_tar = get_sub_tar('here'); - print "here\n"; - $here_tar->print_filelist(); - exit 0; -} ## end if ($config{filelist}) - -my %script_config = (%default_config, get_config()); -if ($config{show}) { - require Data::Dumper; - print {*STDOUT} Data::Dumper::Dumper(\%script_config); - exit 1; -} - -# Merge configurations and go on -%config = (%script_config, %config); - -if ($config{inspect}) { - $config{cleanup} = 0; - $config{'deploy'} = 0; - $config{'tempdir'} = 0; - $config{workdir} = $config{inspect}; -} ## end if ($config{inspect}) - -if ($config{dryrun}) { - require Data::Dumper; - print {*STDOUT} Data::Dumper::Dumper(\%config); - exit 1; -} - -# go into the working directory, creating any intermediate if needed -mkpath($config{workdir}); -chdir($config{workdir}); -print {*STDERR} "### Got into working directory '$config{workdir}'\n\n"; - -my $tempdir; -if ($config{'tempdir'}) { # Only if allowed - my $now = strftime('%Y-%m-%d_%H-%M-%S', localtime); - $tempdir = - tempdir($now . 'X' x 10, DIR => '.', CLEANUP => $config{cleanup}); - - chdir $tempdir; - print {*STDERR} - "### Created and got into temporary directory '$tempdir'\n"; - print {*STDERR} "### (will clean it up later)\n" if $config{cleanup}; - print {*STDERR} "\n"; -} ## end if ($config{'tempdir'}) - -eval { # Not really needed, but you know... - $ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin'; - save_files(); - execute_deploy_programs() if $config{'deploy'}; -}; -carp $EVAL_ERROR if $EVAL_ERROR; - -# Get back so that cleanup can successfully happen, if requested -chdir '..' if defined $tempdir; - - -sub locate_file { - my ($filename) = @_; - my $fh = \*DATA; - seek $fh, $DATA_POSITION, SEEK_SET; - while (! eof $fh) { - chomp(my $sizes = <$fh>); - my ($name_size, $file_size) = split /\s+/, $sizes; - my $name = full_read($fh, $name_size); - full_read($fh, 1); # "\n" - return ($fh, $file_size) if $name eq $filename; - seek $fh, $file_size + 2, SEEK_CUR; # includes "\n\n" - } - die "could not find '$filename'"; -} - -sub full_read { - my ($fh, $size) = @_; - my $retval = ''; - while ($size) { - my $buffer; - my $nread = read $fh, $buffer, $size; - die "read(): $OS_ERROR" unless defined $nread; - die "unexpected end of file" unless $nread; - $retval .= $buffer; - $size -= $nread; - } - return $retval; -} - -sub copy { - my ($ifh, $ofh, $size) = @_; - while ($size) { - my $buffer; - my $nread = read $ifh, $buffer, ($size < 4096 ? $size : 4096); - die "read(): $OS_ERROR" unless defined $nread; - die "unexpected end of file" unless $nread; - print {$ofh} $buffer; - $size -= $nread; - } - return; -} - -sub get_sub_tar { - my ($filename) = @_; - my ($fh, $size) = locate_file($filename); - return Deployable::Tar->new(%config, fh => $fh, size => $size); -} ## end sub get_sub_tar - -sub get_config { - my ($fh, $size) = locate_file('config.pl'); - my $config_text = full_read($fh, $size); - my $config = eval 'my ' . $config_text or return; - return $config unless wantarray; - return %$config; -} ## end sub get_config - -sub save_files { - my $here_tar = get_sub_tar('here'); - $here_tar->extract(); - - my $root_dir = $config{inspect} ? 'root' : '/'; - mkpath $root_dir unless -d $root_dir; - my $cwd = getcwd(); - chdir $root_dir; - my $root_tar = get_sub_tar('root'); - $root_tar->extract(); - chdir $cwd; - - return; -} ## end sub save_files - -sub execute_deploy_programs { - my @deploy_programs = @{$config{deploy} || []}; - - if ($config{bundle}) { # add all executable scripts in current directory - print {*STDERR} "### Auto-deploying all executables in main dir\n\n"; - my %flag_for = map { $_ => 1 } @deploy_programs; - opendir my $dh, '.'; - for my $item (sort readdir $dh) { - next if $flag_for{$item}; - next unless ((-f $item) || (-l $item)) && (-x $item); - $flag_for{$item} = 1; - push @deploy_programs, $item; - } ## end for my $item (sort readdir... - closedir $dh; - } ## end if ($config{bundle}) - - DEPLOY: - for my $deploy (@deploy_programs) { - $deploy = catfile('.', $deploy) - unless file_name_is_absolute($deploy); - if (!-x $deploy) { - print {*STDERR} "### Skipping '$deploy', not executable\n\n"; - next DEPLOY; - } - print {*STDERR} "### Executing '$deploy'...\n"; - system {$deploy} $deploy; - print {*STDERR} "\n"; - } ## end for my $deploy (@deploy_programs) - - return; -} ## end sub execute_deploy_programs - - -sub usage { - print {*STDOUT} <<"END_OF_USAGE" ; -$0 version $VERSION - -More or less, this script is intended to be launched without parameters. -Anyway, you can also set the following options, which will override any -present configuration (except in "--show-options"): - -* --usage | --man | --help - print these help lines and exit - -* --version - print script version and exit - -* --bundle | --all-exec | -X - treat all executables in the main deployment directory as scripts - to be executed - -* --cleanup | -c | --no-cleanup - perform / don't perform temporary directory cleanup after work done - -* --deploy | --no-deploy - deploy scripts are executed by default (same as specifying '--deploy') - but you can prevent it. - -* --dryrun | --dry-run - print final options and exit - -* --filelist | --list | -l - print a list of files that are shipped in the deploy script - -* --heretar | --here-tar | -H - print out the tar file that contains all the files that would be - extracted in the temporary directory, useful to redirect to file or - pipe to the tar program - -* --inspect | -i - just extract all the stuff into for inspection. Implies - --no-deploy, --no-tempdir, ignores --bundle (as a consequence of - --no-deploy), disables --cleanup and sets the working directory - to - -* --no-tar - don’t use system "tar" - -* --roottar | --root-tar | -R - print out the tar file that contains all the files that would be - extracted in the root directory, useful to redirect to file or - pipe to the tar program - -* --show | --show-options | -s - print configured options and exit - -* --tar | -t - set the system "tar" program to use. - -* --tempdir | --no-tempdir - by default a temporary directory is created (same as specifying - '--tempdir'), but you can execute directly in the workdir (see below) - without creating it. - -* --workdir | --work-directory | --deploy-directory | -w - working base directory (a temporary subdirectory will be created - there anyway) - -END_OF_USAGE - exit 1; -} ## end sub usage - -sub version { - print "$0 version $VERSION\n"; - exit 1; -} - - -package Deployable::Tar; - -sub new { - my $package = shift; - my $self = { ref $_[0] ? %{$_[0]} : @_ }; - $package = 'Deployable::Tar::Internal'; - if (! $self->{'no-tar'}) { - if ((exists $self->{tar}) || (open my $fh, '-|', 'tar', '--help')) { - $package = 'Deployable::Tar::External'; - $self->{tar} ||= 'tar'; - } - } - bless $self, $package; - $self->initialise() if $self->can('initialise'); - return $self; -} - -package Deployable::Tar::External; -use English qw( -no_match_vars ); - -sub initialise { - my $self = shift; - my $compression = $self->{bzip2} ? 'j' - : $self->{gzip} ? 'z' - : ''; - $self->{_list_command} = 'tv' . $compression . 'f'; - $self->{_extract_command} = 'x' . $compression . 'f'; -} - -sub print_filelist { - my $self = shift; - open my $tfh, '|-', $self->{tar}, $self->{_list_command}, '-' - or die "open() on pipe to tar: $OS_ERROR"; - main::copy($self->{fh}, $tfh, $self->{size}); - return $self; -} - -sub extract { - my $self = shift; - open my $tfh, '|-', $self->{tar}, $self->{_extract_command}, '-' - or die "open() on pipe to tar: $OS_ERROR"; - main::copy($self->{fh}, $tfh, $self->{size}); - return $self; -} - -package Deployable::Tar::Internal; -use English qw( -no_match_vars ); - -sub initialise { - my $self = shift; - - my $data = main::full_read($self->{fh}, $self->{size}); - open my $fh, '<', \$data or die "open() on internal variable: $OS_ERROR"; - - require Archive::Tar; - $self->{_tar} = Archive::Tar->new(); - $self->{_tar}->read($fh); - - return $self; -} - -sub print_filelist { - my $self = shift; - print {*STDOUT} " $_\n" for $self->{_tar}->list_files(); - return $self; -} - -sub extract { - my $self = shift; - $self->{_tar}->extract(); - return $self; -} - -__END__ -9 95 -config.pl -$VAR1 = { - 'deploy' => [], - 'bzip2' => 1, - 'bundle' => 1 - }; - - -4 163 -here -BZh11AY&SYÅM_Y„„âxÿ€@À~eÞ r“@шÐh=dL©ˆh ꞣM dÌéMí“�@®D�EÐqXs¹ (á²Æ|JïqgPŚР5�Çi ªªs„~ÌÞaìµE÷üò=ù¼9²<$’Õ;•Š1Q‡‘×2ð ­P�1€ü]ÉáBC5}d - -4 489 -root -BZh11AY&SY‰.¾ï’ÿ„ã�`ÿˆ‹Ï�þeßà@]•"¢†@ „Õ&“j` a ‚†@¢ -&¦È="14§©�艀jnïDòLñC;`Ò<$!TK©¾$= –ö5F¬Í™äÚ5F/jH”’hCn F(wšµbõ&î—†Æ61Œn$B2!4¢B‹"±ÿ€¿,ÕÈ’‰(ž?ýzÈcm¸ùÜ×±ñ<æ$¯ –ß2©€%Ä -°PΦ8§Š!.@š�×n¾¿ï_U±ÙÞfÇf1²ø*ºˆDŒ?�©¯Iö%¡<¤Ò% ¨ÉYí@î<¡,Ài&ÄÖ”"Hfc3‘fñ$ÏjMÚÆ�T§C½¬­)„Qr–‡-I¬4šC"z¥”²%‹™l\ªP‹aŠÛ襑 ÅN{Œæhȉô¢PŽÊlû &‰&d¢'‘¨Ú‰dMhû¶5–ŸK�z|#ì‰Tjzü£·¢o"d¨‚'¾m“  -|"`pµDÁ"QhÕÏ÷ô@Æ~+Ͷޤ"Ʊ„mnD€7ÑÁ:&‘,[r$"UÈf ‚P“…Eÿ‹¹"œ(HD—_w€ - -- 2.11.4.GIT