Merge branch 'migrate_to_catalyst' into reportemptyhomes

1 files changed, 265 insertions, 0 deletions

diff --git a/perl-external/bin/module-manage.pl b/perl-external/bin/module-manage.pl
new file mode 100755
index 000000000..5e826aabf
--- /dev/null
+++ b/perl-external/bin/module-manage.pl
@@ -0,0 +1,265 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use IPC::Run3;
+use LWP::Simple;
+use File::Slurp;
+use Path::Class;
+use List::MoreUtils 'uniq';
+
+# TODO - 'updates' action that lists packages that could be updated
+# TODO - add smarts to strip out old packages (could switch to building using files.txt after)
+
+my $root_dir               = file(__FILE__)->dir->parent->absolute->stringify;
+my $module_list            = "$root_dir/modules.txt";
+my $file_list              = "$root_dir/files.txt";
+my $minicpan               = "$root_dir/minicpan";
+my $local_packages_file    = "$minicpan/modules/02packages.details.txt";
+my $local_packages_file_gz = "$local_packages_file.gz";
+
+my %actions = (
+    add            => \&add,
+    build_all      => \&build_all,
+    fetch_all      => \&fetch_all,
+    force_install  => \&force_install,
+    index_minicpan => \&index_minicpan,
+    init           => \&init,
+    setup          => \&setup,
+    sort_files     => \&sort_files,
+    zap            => \&zap,
+);
+
+# work out what to run
+my ( $action, @args ) = @ARGV;
+$actions{$action}
+  ? $actions{$action}->(@args)
+  : die("Usage: $0 action [...]\n  actions: "
+      . join( ', ', sort keys %actions )
+      . "\n" );
+
+exit;
+
+############################################################################
+
+sub init {
+    add('App::cpanminus');
+}
+
+sub setup {
+    fetch_all();
+    build('App::cpanminus');
+    build_all();
+}
+
+sub add {
+    my $module = shift || die "Usage: $0 add Dist::To::Add";
+
+    # try to install the distribution using cpanm
+    my $out = '';
+    my $cmd = "cpanm --reinstall --save-dists $minicpan $module";
+
+    run3( $cmd, undef, undef, undef )
+      || die "Error running '$cmd'";
+
+    write_file( $module_list, { append => 1 }, "$module\n" );
+
+    index_minicpan();
+    sort_files();
+}
+
+sub index_minicpan {
+
+    # Go through all files in minicpan and add to files.txt
+    my @files = sort map { s{^.*?(/authors/id/.*)$}{$1}; $_ }
+      split '\s', `find $minicpan/authors -type f`;
+    write_file( $file_list, map { "$_\n" } @files );
+
+    # work out which ones are not currently in packages
+    my @local_packages_lines = read_packages_txt_gz($local_packages_file_gz);
+
+    # Are there any missing files?
+    my @missing_files = ();
+  MINICPAN_FILE:
+    foreach my $file (@files) {
+        my ($auth_and_file) = $file =~ m{/authors/id/./../(.*)$};
+
+        foreach my $line (@local_packages_lines) {
+            next MINICPAN_FILE if $line =~ m{$auth_and_file};
+        }
+
+        push @missing_files, $auth_and_file;
+    }
+
+    # If there are no missing files we can stop
+    return unless @missing_files;
+
+    # Fetch 02packages off live cpan
+    my $remote_packages_url =
+      'http://cpan.perl.org/modules/02packages.details.txt.gz';
+    my $remote_packages_file = "$minicpan/modules/remote_packages.txt.gz";
+    print "  Fetching '$remote_packages_url'...\n";
+    is_error( mirror( $remote_packages_url, $remote_packages_file ) )
+      && die "Could not retrieve '$remote_packages_url'";
+    print "  done...\n";
+
+    my @remote_packages_lines = read_packages_txt_gz($remote_packages_file);
+
+    # Find remaining in live file and add to local file
+    my %lines_to_add = ();
+    foreach my $missing (@missing_files) {
+        print "  Finding matches for '$missing'\n";
+        my @matches = grep { m{$missing} } @remote_packages_lines;
+        next unless @matches;
+        $lines_to_add{$missing} = \@matches;
+    }
+
+    # for packages still not found parse out the contents
+    foreach my $missing (@missing_files) {
+        next if $lines_to_add{$missing};
+
+        # do a require here so that this module does not prevent 'setup' from
+        # being run - needed to install it.
+        require CPAN::ParseDistribution;
+
+        print "  Parsing out matches for '$missing'\n";
+
+        my ( $A, $B ) = $missing =~ m{^(.)(.)};
+        my $dist =
+          CPAN::ParseDistribution->new("$minicpan/authors/id/$A/$A$B/$missing");
+
+        my $modules = $dist->modules();
+        my @matches = ();
+
+        foreach my $module ( sort keys %$modules ) {
+            my $version = $modules->{$module} || 'undef';
+
+            # Zucchini 0.000017 C/CH/CHISEL/Zucchini-0.0.17.tar.gz
+            push @matches, "$module $version $A/$A$B/$missing\n";
+        }
+
+        $lines_to_add{$missing} = \@matches;
+    }
+
+    # combine and sort the lines found
+    my @new_lines = sort @local_packages_lines,
+      map { @$_ } values %lines_to_add;
+    unlink $local_packages_file_gz;
+    write_file( $local_packages_file, map { "$_\n" } packages_file_headers(),
+        @new_lines );
+    system "gzip -v $local_packages_file";
+}
+
+sub read_packages_txt_gz {
+    my $file = shift;
+
+    return unless -e $file;
+
+    my @lines = split /\n/, `zcat $file`;
+
+    # ditch the headers
+    while ( my $line = shift @lines ) {
+        last if $line =~ m{^\s*$};
+    }
+
+    return @lines;
+}
+
+sub packages_file_headers {
+
+    # this is all fake stuff
+
+    return << 'END_OF_LINES';
+Allow-Packages-Only-Once: 0
+Columns: package name, version, path
+Description: Package names for my private CPAN
+File: 02packages.details.txt
+Intended-For: My private CPAN
+Last-Updated: Wed, 04 May 2011 09:59:13 GMT
+Line-Count: 1389
+URL: http://example.com/MyCPAN/modules/02packages.details.txt
+Written-By: /home/evdb/fixmystreet/perl-external/local-lib/bin/dpan using CPAN::PackageDetails 0.25    
+
+END_OF_LINES
+}
+
+sub build_all {
+    my @modules = sort uniq map { s{\s+$}{}; $_; } read_file($module_list);
+    build($_) for @modules;
+}
+
+sub build {
+    my $module = shift    #
+      || die "Usage: $0 build Module::To::Build\n";
+
+    print "  --- checking/installing $module ---\n";
+
+    my $out = '';
+    my $cmd = "cpanm --mirror $minicpan --mirror-only  $module";
+
+    # print "  running '$cmd'\n";
+
+    run3( $cmd, undef, \$out, \$out )
+      || die "Error running '$cmd'";
+
+    my @lines =
+      grep { m{\S} }
+      split /\n+/, $out;
+    my $last_line = $lines[-1];
+
+    die "Error building '$module':\n\n$last_line\n\n$out\n\n"
+      unless $last_line =~ m{Successfully installed }
+          || $last_line =~ m{is up to date}
+          || $last_line =~ m{\d+ distributions? installed};
+}
+
+sub fetch_all {
+    my @urls = sort uniq map { s{\s+$}{}; $_; } read_file($file_list);
+    fetch($_) for @urls;
+}
+
+sub fetch {
+    my $filename = shift;
+
+    my $destination = file("$minicpan/$filename");
+    $destination->dir->mkpath;
+
+    return if -e $destination;
+
+    # create a list of urls to try in order
+    my @urls = (
+        "http://search.cpan.org/CPAN" . $filename,
+        "http://backpan.perl.org" . $filename,
+    );
+
+    while ( scalar @urls ) {
+        my $url = shift @urls;
+
+        # try to fetch
+        print "  Fetching '$url'...\n";
+        last if is_success( getstore( $url, "$destination" ) );
+
+        # if more options try again
+        next if scalar @urls;
+
+        # could not retrieve - die
+        die "ERROR - ran out of urls fetching '$filename'";
+    }
+}
+
+sub zap {
+
+    # delete all the bits that are generated
+    my $local_lib_root = $ENV{PERL_LOCAL_LIB_ROOT} || die;
+    dir($local_lib_root)->rmtree(1);
+    dir($minicpan)->subdir('authors')->rmtree(1);
+}
+
+sub sort_files {
+    foreach my $file ( $file_list, $module_list ) {
+        my @entries = read_file($file);
+        @entries = uniq sort @entries;
+        write_file( $file, @entries );
+    }
+}