#!/usr/bin/perl -w use strict; my $VERSION = 0.01; # ------------------------------------- # Library Modules use Archive::Extract; use File::Basename; use File::Find::Rule; use File::Path; use Getopt::Long; use IO::File; # ------------------------------------- # Variables my (%options); my $BUILD_DIR = '/tmp/gitbuild'; my $GITHUB_ID = 'barbie'; # ------------------------------------- # Program ##### INITIALISE ##### init_options(); ##### MAIN ##### vcs_initialise(); vcs_archive_files(); vcs_current_files(); print "DONE\n" if($options{verbose}); # ------------------------------------- # Subroutines sub vcs_initialise { print "Creating git repo ...\n"; my $target = lc basename($options{target}); mkpath($BUILD_DIR); mkpath($options{target}); chdir($options{target}); run_cmd(qq!git init!); run_cmd(qq!git remote add origin git\@github.com:$GITHUB_ID/$target.git!); } sub vcs_archive_files { my @files = glob( "$options{source}/*.tar.gz" ); for my $file (sort @files) { print "Importing archive '$file' ...\n"; my ($dist,$vers) = $file =~ m!.*/(.*?)-([\d._]+).tar.gz!; unless($dist && $vers) { die "ERROR: [$file] => [$dist]-[$vers]\n"; } my $EXPECTEDPATH = "$BUILD_DIR/$dist-$vers"; print "... $EXPECTEDPATH\n" if($options{verbose}); my $ae = Archive::Extract->new( archive => $file ); $ae->extract(to => $BUILD_DIR); run_cmd(qq!cp -r $EXPECTEDPATH/* .!); run_cmd(qq!git add .!); run_cmd(qq!git commit -m "imported from version $vers, see Changes file."!); my @current = File::Find::Rule->file()->name( '*' )->in( '.' ); my @expected = load_manifest($EXPECTEDPATH); my %expected = map {$_ => 1} @expected; my $deletes = 0; for my $f (@current) { $f =~ s!^\.\/!!; next if($expected{$f} || $f =~ /^\.git/); print " .. deleting $f\n"; run_cmd(qq!git rm $f!); $deletes++; } run_cmd(qq!git commit -m "removing obselete files."!) if($deletes); run_cmd(qq!git tag release-$vers!); run_cmd(qq!rm -rf $EXPECTEDPATH!); } } sub vcs_current_files { print "Importing current ...\n"; my @current = File::Find::Rule->file()->name( '*' )->in( '.' ); my @expected = load_manifest($options{source}); my %expected = map {$_ => 1} @expected; for my $file (@expected) { run_cmd(qq!cp $options{source}/$file $options{target}/$file!); } run_cmd(qq!git add .!); run_cmd(qq!git commit -m "importing latest updates, see Changes file."!); my $deletes = 0; for my $f (@current) { $f =~ s!^\.\/!!; next if($expected{$f} || $f =~ /^\.git/); print " .. deleting $f\n"; run_cmd(qq!git rm $f!); $deletes++; } run_cmd(qq!git commit -m "removing obselete files."!) if($deletes); } sub run_cmd { my $command = shift; print " .. command = $command\n" if($options{verbose}); my $output; eval {$output = `$command`}; fatal("command failed: command=[%s], errstr='%s'\n",$command,$@) if($@); fatal("command failed: command=[%s], errstr='%s'\n",$command,$!) if($? == -1); fatal("command failed: command=[%s], errstr='%s'\n",$command,$output) if($output =~ /: Permission denied/i); } sub fatal { my $format = shift || return; my $str = @_ ? sprintf($format,@_) : $format; die $str; } sub load_manifest { my $path = shift; my $file = $path . '/MANIFEST'; print " .. manifest $file\n" if($options{verbose}); fatal("manifest missing: file=[%s]\n",$file) unless(-f $file); my @list; my $fh = IO::File->new($file,'r') or fatal("manifest open failed: file=[%s], errstr='%s'\n",$file,$!); while(<$fh>) { chomp; s![\t\s].*$!!; next unless($_); push @list, $_; } $fh->close; return @list; } sub init_options { GetOptions( \%options, 'force|f', 'verbose|v', 'source|s', 'target|t', 'help|h' ); help(1) if($options{help}); #help(0) if($options{version}); unless($options{source} && $options{target}) { ($options{source},$options{target}) = @ARGV; } help(1,"source directory not given") unless($options{source}); help(1,"target directory not given") unless($options{target}); rmtree($options{target}) if($options{force}); help(1,"unable to access source directory [$options{source}]") unless(-d $options{source} && -r $options{source}); help(1,"target [$options{target}] is a file!") if(-f $options{target}); help(1,"target directory [$options{target}] already exists") if(-d $options{target}); } sub help { my ($full,$mess) = @_; print "\n$mess\n" if($mess); if($full) { print < -t= | ) -f force removal of target -v display verbose messages -s source directory -t target directory -h this help screen HERE } print "$0 v$VERSION\n\n"; exit(0); } __END__ =head1 AUTHOR Barbie, for Miss Barbell Productions . =head1 COPYRIGHT AND LICENSE Copyright (C) 2009 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