diff options
Diffstat (limited to 'perl-external/bin/module-manage.pl')
| -rwxr-xr-x | perl-external/bin/module-manage.pl | 154 |
1 files changed, 115 insertions, 39 deletions
diff --git a/perl-external/bin/module-manage.pl b/perl-external/bin/module-manage.pl index 5cdcc0334..187340da8 100755 --- a/perl-external/bin/module-manage.pl +++ b/perl-external/bin/module-manage.pl @@ -9,10 +9,15 @@ use File::Slurp; use Path::Class; use List::MoreUtils 'uniq'; -my $root_dir = file(__FILE__)->dir->parent->absolute->stringify; -my $module_list = "$root_dir/modules.txt"; -my $url_list = "$root_dir/urls.txt"; -my $minicpan = "$root_dir/minicpan"; +# 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, @@ -30,7 +35,9 @@ my %actions = ( my ( $action, @args ) = @ARGV; $actions{$action} ? $actions{$action}->(@args) - : die "Usage: $0 action [args ...]\n"; + : die("Usage: $0 action [...]\n actions: " + . join( ', ', sort keys %actions ) + . "\n" ); exit; @@ -38,13 +45,11 @@ exit; sub init { add('App::cpanminus'); - add('MyCPAN::App::DPAN'); } sub setup { fetch_all(); build('App::cpanminus'); - build('MyCPAN::App::DPAN'); build_all(); } @@ -53,42 +58,100 @@ sub add { # try to install the distribution using cpanm my $out = ''; - my $cmd = "cpanm --reinstall $module"; + my $cmd = "cpanm --reinstall --save-dists $minicpan $module"; - # print " running '$cmd'\n"; - run3( $cmd, undef, \$out, \$out ) + run3( $cmd, undef, undef, undef ) || die "Error running '$cmd'"; - my @fetched_urls = - map { s{.*(http://\S+).*}{$1}; $_ } - grep { m{^Fetching http://search.cpan.org} } - split /\n/, $out; - write_file( $module_list, { append => 1 }, "$module\n" ); - write_file( $url_list, { append => 1 }, map { "$_\n" } @fetched_urls ); - sort_files(); - fetch_all(); index_minicpan(); - - if ( $out =~ m{FAIL} ) { - die "\n\n\n" - . "ERROR: Something did not build correctly" - . " - please see ~/.cpanm/build_log for details" - . "\n\n\n"; - } + sort_files(); } sub index_minicpan { - # go to the minicpan dir and run dpan there - if ( `which dpan` =~ m/\S/ ) { - chdir $minicpan; - system "dpan -f ../dpan_config"; + # 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; } - else { - warn "Skipping indexing - could not find dpan"; + + # 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"; + push @lines_to_add, grep { m{$missing} } @remote_packages_lines; } + + # combine and sort the lines found + my @new_lines = sort @local_packages_lines, @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 { @@ -122,24 +185,37 @@ sub build { } sub fetch_all { - my @urls = sort uniq map { s{\s+$}{}; $_; } read_file($url_list); + my @urls = sort uniq map { s{\s+$}{}; $_; } read_file($file_list); fetch($_) for @urls; } sub fetch { - my $url = shift; - my ($filename) = $url =~ m{/(authors/.+)$}; + my $filename = shift; my $destination = file("$minicpan/$filename"); $destination->dir->mkpath; return if -e $destination; - print " Fetching $url\n"; - print " -> $destination\n"; + # 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; - is_success( getstore( $url, "$destination" ) ) - || die "Error saving $url to $destination"; + # 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 { @@ -151,7 +227,7 @@ sub zap { } sub sort_files { - foreach my $file ( $url_list, $module_list ) { + foreach my $file ( $file_list, $module_list ) { my @entries = read_file($file); @entries = uniq sort @entries; write_file( $file, @entries ); |