r26806 - /scripts/lookup-requirements

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Thu Nov 13 19:03:01 UTC 2008


Author: dmn
Date: Thu Nov 13 19:02:56 2008
New Revision: 26806

URL: http://svn.debian.org/wsvn/?sc=1&rev=26806
Log:
add lookup-requirements tool for detecting missing required modules

Added:
    scripts/lookup-requirements   (with props)

Added: scripts/lookup-requirements
URL: http://svn.debian.org/wsvn/scripts/lookup-requirements?rev=26806&op=file
==============================================================================
--- scripts/lookup-requirements (added)
+++ scripts/lookup-requirements Thu Nov 13 19:02:56 2008
@@ -1,0 +1,124 @@
+#!/usr/bin/perl
+#
+# © 2008 Damyan Ivanov
+# As long as you retain this notice you can do whatever you want with
+# this file. If some day you meet some of the authors, and you think
+# this stuff is worth it, you can buy them a beer in return
+
+# Parse a CPAN module's META.yaml
+# and print a list of dependant modules that either have no Debian
+# packages or Debian packages' version is lower than the required
+
+# Needs to have Contents-$ARCH.gz and Packages.gz in the current
+# directory (ok, $ARCH is hard-coded atm).
+# Needs a META.yml file given as an aragument
+
+# TODO: make it download Contents/Packages from the configured
+# (sources.list) mirror. Say once a day is enough. Parsed hashes are
+# cached (as now).
+# TODO: command-line parameters to force/disable refreshing of the
+# caaches
+# TODO: is using the system-wide availability file a good idea? It may
+# contain packages from unofficial or experimental sources.
+
+use strict;
+use warnings;
+
+use IO::Uncompress::Gunzip;
+use YAML qw(LoadFile);
+use Storable();
+use Parse::Debian::Packages;
+use AptPkg::Config ();
+
+my $apt_vers = $AptPkg::Config::_config->system->versioning;
+
+my $meta = LoadFile($ARGV[0]);
+my $requirements = $meta->{requires};
+
+my $contents = "Contents-amd64.gz";
+my $contents_cache = "Contents.cache";
+
+my $packages = "Packages.gz";
+my $packages_cache = "Packages.cache";
+
+my $files;
+
+if( not -e $contents_cache or -M $contents < -M $contents_cache )
+{
+    print "Parsing $contents...\n";
+    my $f = IO::Uncompress::Gunzip->new($contents);
+    my $capturing = 0;
+    while( defined($_ = $f->getline) )
+    {
+        if( $capturing )
+        {
+            my($file, $packages) = split(/\s+/);
+
+            next unless $file =~ s{^usr/(?:share|lib)/perl(?:5|/[\d.]+)/}{};
+
+            $files->{$file} = $packages;
+        }
+        else
+        {
+            if( /^FILE\s+LOCATION/ ) {
+                $capturing = 1;
+            }
+        }
+    }
+
+    Storable::store($files, $contents_cache);
+}
+else
+{
+    $files = Storable::retrieve($contents_cache);
+}
+
+print "I know about ".scalar(keys(%$files))." files\n";
+
+my $pkg_ver;
+
+if( not -e $packages_cache or -M $packages < -M $packages_cache )
+{
+    print "Parsing $packages...\n";
+    my $f = IO::Uncompress::Gunzip->new($packages);
+    my $parser = Parse::Debian::Packages->new( $f );
+    while (my %pkg = $parser->next) {
+        $pkg_ver->{$pkg{Package}} = $pkg{Version};
+    }
+
+    Storable::store($pkg_ver, $packages_cache);
+}
+else
+{
+    $pkg_ver = Storable::retrieve($packages_cache);
+}
+
+print "I know about ".scalar(keys(%$pkg_ver))." packages\n";
+
+REQUIREMENT:
+while(my($mod,$ver) = each %$requirements)
+{
+    my $file = $mod;
+    $file =~ s{::}{/}g;
+    $file .= ".pm";
+    if( my $pkgs = $files->{$file} )
+    {
+        my @pkgs = split(/,/, $pkgs);
+        s{.+/}{} for @pkgs;
+
+        for(@pkgs)
+        {
+            next REQUIREMENT
+            if not $ver
+                or $apt_vers->compare($ver, $pkg_ver->{$_}) <= 0;
+        }
+
+        # append versions
+        @pkgs = map( $_ . '(' . $pkg_ver->{$_} . ')', @pkgs );
+        print "$mod found in ".join( ', ', @pkgs ).", but we need version $ver\n";
+    }
+    else
+    {
+        print "Module $mod ($ver) not found\n";
+    }
+}

Propchange: scripts/lookup-requirements
------------------------------------------------------------------------------
    svn:executable = *




More information about the Pkg-perl-cvs-commits mailing list