pinto-export might make epan... obsolete!

bin/pinto-export

@@ -0,0 +1,362 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Carp;
+use Pod::Usage qw( pod2usage );
+use Getopt::Long qw( :config gnu_getopt );
+use English qw( -no_match_vars );
+my $VERSION = '0.0.1';
+use Archive::Tar;
+use IPC::Run ();
+use 5.012;
+use List::MoreUtils qw< uniq >;
+use Path::Class qw< dir file foreign_dir foreign_file >;
+
+# Other recommended modules (uncomment to use):
+#  use IO::Prompt;
+#  use Readonly;
+#  use Data::Dumper;
+
+# Integrated logging facility
+use Log::Log4perl::Tiny qw( :easy :no_extra_logdie_message );
+Log::Log4perl->easy_init({level=>$INFO, layout=>'[%d %-5p] %m%n'});
+
+my %config = ( output => 'distro-archive.tar' );
+GetOptions(
+   \%config,
+   qw(
+      output|o=s
+      prefix|p:s 
+      root|r=s
+      stack|s=s
+     usage! help! man! version!
+     )
+) or pod2usage(-verbose => 99, -sections => 'USAGE');
+pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
+  if $config{version};
+pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
+pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
+  if $config{help};
+pod2usage(-verbose => 2) if $config{man};
+
+# Script implementation here
+INFO "getting list of distributions from pinto...";
+my $distros = get_distro_list(\%config);
+
+INFO "getting pinto's root...";
+my $root = find_root($distros)
+   or LOGDIE "could not find root";
+$root = $root->subdir(stacks => $config{stack})
+   if defined $config{stack};
+INFO "working on root: $root";
+
+INFO "building list of ancillary files...";
+my @files = map {
+   [ foreign_file(Unix => @$_), $root->file(@$_) ];
+} (
+   [ qw< authors 01mailrc.txt.gz > ],
+   [ qw< modules 02packages.details.txt.gz > ],
+   [ qw< modules 03modlist.data.gz > ],
+);
+
+INFO "building archive...";
+my $archive = Archive::Tar->new();
+
+my $prefix;
+if (defined $config{prefix}) {
+   $prefix = dir(length($config{prefix})
+      ? $config{prefix}
+      : get_stack(\%config, $root));
+}
+for my $spec (@files, @$distros) {
+   my ($name, $path) = @$spec;
+   $name = $prefix->file($name) if defined $prefix;
+   INFO "$name";
+   my ($file) = $archive->add_files($path);
+   $file->rename($name);
+}
+
+INFO "saving into $config{output}";
+$archive->write($config{output});
+
+sub get_distro_list {
+   my ($args) = @_;
+
+   my @command = qw< pinto >;
+   push @command, '--root' => $args->{root}
+      if exists $args->{root};
+   push @command, 'list';
+   push @command, '--stack' => $args->{stack}
+      if exists $args->{stack};
+   push @command, '--format' => "%h|%H";
+
+   my ($out, $err);
+   IPC::Run::run(\@command, \undef, \$out, \$err)
+      or LOGDIE "pinto: $OS_ERROR";
+   LOGDIE "stderr from execution: $err" if defined($err) && length($err);
+
+   # transform list from pinto
+   return [ map {
+      my ($b, $f) = split /\|/, $_;
+      [ foreign_file(Unix => "authors/id/$b"), file($f) ];
+   } uniq(sort(split /\n/, $out)) ];
+}
+
+sub get_stack {
+   my ($args, $root) = @_;
+   return $args->{stack} if exists $args->{stack};
+   my $link = file(readlink $root->file('modules'));
+   $link = $link->parent();
+   return $link->basename();
+}
+
+sub find_root {
+   my @list = @{$_[0]};
+   my $root;
+   $root = _find_root(@{shift @list})
+      while (! $root) && @list;
+   return $root;
+}
+
+sub _find_root {
+   my ($bare, $full) = @_;
+   while ((my $base_bare = $bare->basename()) ne '.') {
+      my $base_full = $full->basename();
+      if ($base_bare ne $base_full) {
+         WARN "mismatch between $bare and $full";
+         return;
+      }
+      $bare = $bare->parent();
+      $full = $full->parent();
+   }
+   return $full;
+}
+
+__END__
+
+=head1 NAME
+
+pinto-export - export a Pinto stack to a tar archive
+
+=head1 VERSION
+
+Ask the version number to the script itself, calling:
+
+   shell$ pinto-export --version
+
+
+=head1 USAGE
+
+   pinto-export [--usage] [--help] [--man] [--version]
+
+   pinto-export [--output|-o <filename>]
+                [--prefix|-p [<prefix>]]
+                [--root|-r <repository-root-dir>]
+                [--stack|-s <stack-name>]
+
+=head1 EXAMPLES
+
+   # export default stack from default repository, see pinto's
+   # manual for setting them. Saves into distro-archive.tar by
+   # default
+   shell$ pinto-export
+
+   # ditto, saving in custom file
+   shell$ pinto-export -o default.tar
+
+   # getting a specific stack
+   shell$ pinto-export -s mystack -o mystack.tar
+
+   # setting the repository root directory
+   shell$ pinto-export -r /path/to/repo -s somestack -o whatever.tar
+
+   # set a prefix in the filename inside the TAR archive
+   shell$ pinto-export -p mydir
+
+   # set the prefix the same as the stack name
+   shell$ pinto-export -p
+
+=head1 DESCRIPTION
+
+Pinto (L<http://www.stratopan.com/>) is a wonderful tool for building up
+custom CPAN-like repositories of modules.
+
+Sometimes, you have to just pack one such repository and transfer it into
+a machine that is not connected to the Internet. This is where
+C<pinto-export> comes handy: just specify the relevant configurations
+(where your Pinto repository is in your filesystem, which stack you would
+like to export, and to which archive file) and it will create a TAR archive
+of the CPAN-like repository, including all relevant distribution files
+as well as ancillary files for indexing and making C<CPAN.pm> happy.
+
+You will then be able to just extract this archive and point your installer
+to the directory for installing the modules.
+
+=head2 Full Use Case
+
+In your development machine you are ready for packing your
+application. Surely you have a list of direct dependencies, e.g. you
+are using the L<Dancer> framework and L<Dancer::Plugin::FlashNote> as
+well. You want to pack all the dependencies for shipping the whole thing
+to some machine not connected to the Internet.
+
+First of all, create Pinto's stack (see Pinto's documentation for all
+the bells and whistles) and pull all relevant distributions in:
+
+   # assuming that PINTO_REPOSITORY_ROOT is set...
+   shell$ pinto new my-app-stack
+   shell$ pinto pull Dancer Dancer::Plugin::FlashNote
+
+If you packed your application as a distribution, you can use the C<add>
+command as well.
+
+Now we are ready to pack the stack:
+
+   # assuming that PINTO_REPOSITORY_ROOT is still set...
+   shell$ pinto-export -o my-stack.tar -s my-app-stack -p
+
+Note that option C<-p> (without a value) has been specified: this means
+that the archive root directory is set the same as the name of the stack,
+i.e. all files will be put under C<my-app-stack> directory.
+
+Now you can transfer C<my-app-stack.tar> to the destination machine with
+your application and then:
+
+   remote$ tar xf my-stack.tar
+   remote$ cpanm --mirror "$PWD/my-app-stack" --mirror-only ... \
+      [ ... other cpanm options you might want, e.g. -L... ] \
+      Dancer Dancer::Plugin::FlashNote
+
+=head1 OPTIONS
+
+   pinto-export [--output|-o <filename>]
+                [--prefix|-p [<prefix>]]
+                [--root|-r <repository-root-dir>]
+                [--stack|-s <stack-name>]
+
+=over
+
+=item --help
+
+print a somewhat more verbose help, showing usage, this description of
+the options and some examples from the synopsis.
+
+=item --man
+
+print out the full documentation for the script.
+
+=item --output | -o <filename>
+
+set the name of the output file. Whatever the name, it is always saved
+as a plain TAR archive (so no gzip'ing or other fancy stuff).
+
+Defaults to C<distro-archive.tar>.
+
+=item --prefix | -p [<prefix>]
+
+set a prefix in the filenames inside the archive. If absent, the archive's
+internal file tree will start with the C<authors> and <modules> directory:
+
+   authors/01mailrc.txt.gz
+   modules/02packages.details.txt.gz
+   modules/03modlist.data.gz
+   modules/id/...
+   ...
+
+If you specify a C<prefix>, it will be pre-pended, so for example if you
+set it to C<mydir> your archive will contain:
+
+   mydir/authors/01mailrc.txt.gz
+   mydir/modules/02packages.details.txt.gz
+   mydir/modules/03modlist.data.gz
+   mydir/modules/id/...
+   ...
+
+If you pass the option without a value, the name of the stack will be taken,
+either the one provided with C<--stack|-s> or the default one.
+
+=item --root | -r <repository-root-dir>
+
+set the root of the Pinto's repository. This will handed over to Pinto, so
+there is no default value, apart from what you set with the
+C<PINTO_REPOSITORY_ROOT> environment variable.
+
+=item --stack | -s <stack-name>
+
+set the stack that you want to export. If not set, it defaults to whatever
+Pinto thinks that the default stack is.
+
+=item --usage
+
+print a concise usage line and exit.
+
+=item --version
+
+print the version of the script.
+
+=back
+
+=head1 DIAGNOSTICS
+
+C<pinto-export> is pretty verbose on its standard error channel, but
+you should be able to figure out what each diagnostic message means by...
+reading it.
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+C<pinto-export> requires no configuration files.
+
+Although not used by C<pinto-export> directly, you might find the
+C<PINTO_REPOSITORY_ROOT> environment variables quite handy to set
+Pinto's repository root directory.
+
+
+=head1 DEPENDENCIES
+
+Path::Class and List::MoreUtils.
+
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported.
+
+Please report any bugs or feature requests to the author.
+
+
+=head1 AUTHOR
+
+Flavio Poletti C<flavio@polettix.it>
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2013, Flavio Poletti C<flavio@polettix.it>. All rights reserved.
+
+This script is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>
+and L<perlgpl>.
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+=cut