r54114 - /scripts/dpkg-scanpmpackages
jozef-guest at users.alioth.debian.org
jozef-guest at users.alioth.debian.org
Thu Mar 11 19:19:48 UTC 2010
Author: jozef-guest
Date: Thu Mar 11 19:19:42 2010
New Revision: 54114
URL: http://svn.debian.org/wsvn/?sc=1&rev=54114
Log:
added dpkg-scanpmpackages
Added:
scripts/dpkg-scanpmpackages (with props)
Added: scripts/dpkg-scanpmpackages
URL: http://svn.debian.org/wsvn/scripts/dpkg-scanpmpackages?rev=54114&op=file
==============================================================================
--- scripts/dpkg-scanpmpackages (added)
+++ scripts/dpkg-scanpmpackages Thu Mar 11 19:19:42 2010
@@ -1,0 +1,263 @@
+#!/usr/bin/perl
+
+=head1 NAME
+
+dpkg-scanpmpackages - creates PerlPackages index from .deb files
+
+=head1 SYNOPSIS
+
+ dpkg-scanpmpackages [repository_folder]
+
+ --blacklist=comma,separated,package,names
+ optional - packages that should not be indexed
+
+=head1 DESCRIPTION
+
+Finds all F<Packages.bz2> and for all F<*.deb> files listed there indexes
+the Perl modules files F<*.pm> creating F<PerlPackages.bz2> file in the same
+folder.
+
+=cut
+
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use Pod::Usage;
+use File::Find::Rule;
+use File::Basename 'basename', 'dirname';
+use Module::Build::ModuleInfo;
+use File::Temp qw/ tempdir /;
+use File::Path 'remove_tree';
+use IO::Any 0.04;
+use Parse::Deb::Control 0.03;
+use List::MoreUtils 'any', 'firstval';
+use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
+use Carp 'croak';
+
+exit main();
+
+sub main {
+ my $help;
+ my $use_old_index;
+ my $blacklisted_pkgs_arg = 'r-cran-gdata';
+ GetOptions(
+ 'help|h' => \$help,
+ 'blacklist=s' => \$blacklisted_pkgs_arg,
+ ) or pod2usage;
+ pod2usage if $help;
+
+ my $mirror_location = shift @ARGV || '.';
+ pod2usage if not $mirror_location or not -d $mirror_location;
+ #$mirror_location = File::Spec->rel2abs( $mirror_location );
+
+ my @packages_files =
+ File::Find::Rule
+ ->file()
+ ->name( 'Packages.bz2' )
+ ->in( $mirror_location )
+ ;
+
+ my @blacklisted_pkgs = split(/\s*,\s*/, $blacklisted_pkgs_arg);
+
+ # loop through all Packages.bz2 that were found
+ foreach my $packages_file (@packages_files) {
+ print STDERR 'processing ', $packages_file, "\n";
+
+ # read the Packages.bz2 content
+ my $packages_dir = dirname($packages_file);
+ my $packages_bz_content = IO::Any->slurp($packages_file);
+ my $packages_file_content;
+ bunzip2 \$packages_bz_content => \$packages_file_content or die "bunzip2 failed: $Bunzip2Error\n";
+
+ # extract list of all .deb filenames
+ my %deb_to_src;
+ my $packages = Parse::Deb::Control->new($packages_file_content);
+ my @deb_files =
+ grep {
+ die $_.' from '.$packages_file.' does not exists'
+ if ! -f File::Spec->catfile($mirror_location, $_);
+ 1;
+ }
+ map { _trim($_->{'para'}->{'Filename'}) }
+ map {
+ $deb_to_src{_trim($_->{'para'}->{'Filename'})} = _trim($_->{'para'}->{'Source'})
+ if $_->{'para'}->{'Source'};
+ $_;
+ }
+ grep { not _trim($_->{'para'}->{'Package'}) ~~ \@blacklisted_pkgs }
+ $packages->get_keys('Filename')
+ ;
+
+ my %provides;
+ my %deb_filenames;
+
+ # read the already processed packages
+ my $perl_packages_bz = File::Spec->catfile($packages_dir, 'PerlPackages.bz2');
+ if (-f $perl_packages_bz) {
+ my $perl_packages_bz_content = IO::Any->slurp($perl_packages_bz);
+ my $perl_packages_file_content;
+ bunzip2 \$perl_packages_bz_content => \$perl_packages_file_content or die "bunzip2 failed: $Bunzip2Error\n";
+ my $idx = Parse::Deb::Control->new($perl_packages_file_content);
+ foreach my $entry ($idx->get_keys('Filename')) {
+ my $filename = ${$entry->{'value'}};
+ $filename =~ s/\s*$//;
+ $filename =~ s/^\s//;
+ my $para = '';
+ foreach my $key (qw(Package Architecture Filename Version Source Perl-Modules)) {
+ $para .= $key.':'.$entry->{'para'}->{$key}
+ if $entry->{'para'}->{$key};
+ }
+
+ $deb_filenames{basename($filename, '.deb')} = $para
+ if any { $_ eq $filename } @deb_files;
+ }
+ }
+
+ # process deb files
+ foreach my $deb_file (@deb_files) {
+ my $deb_name = basename($deb_file, '.deb');
+
+ $provides{$deb_name} = undef;
+
+ # skip already processed
+ next if exists $deb_filenames{$deb_name};
+
+ $deb_filenames{$deb_name} = $deb_file;
+ $provides{$deb_name} = {};
+ my $tmp_dir = tempdir();
+
+ # extract .deb
+ system(
+ 'dpkg',
+ '-x',
+ File::Spec->catfile($mirror_location, $deb_file),
+ $tmp_dir,
+ );
+
+ # get list of .pm files
+ my @pm_files = File::Find::Rule
+ ->file()
+ ->name( '*.pm' )
+ ->in( $tmp_dir )
+ ;
+
+ # find all package names from pm_files
+ foreach my $pm_file (@pm_files) {
+ # add version 0 based on filename, will be set properly later if found
+ if (my $inc_prefix = firstval { index($pm_file, $tmp_dir.$_) == 0 } @INC) {
+ $inc_prefix = $tmp_dir.$inc_prefix;
+ my $package = substr($pm_file, length($inc_prefix)+1, -3);
+ $package =~ s{/}{::}xmsg;
+ $provides{$deb_name}->{$package} = 0;
+ }
+
+ # get module info
+ my $info = eval { Module::Build::ModuleInfo->new_from_file($pm_file) };
+ warn 'failed to get module info of "'.$pm_file.'" - "'.$@.'"' if $@;
+ next if not $info;
+
+ #print 'processing ', $pm_file, "\n";
+
+ $pm_file =~ s{^$tmp_dir.(.+)$}{$1};
+
+ foreach my $package (keys %{$info->{'versions'}}) {
+ next if $package eq 'main';
+
+ # skip inside packages
+ my $package_file = $package.'.pm';
+ $package_file =~ s{::}{/}xmsg;
+ next if substr($pm_file,0-length($package_file)) ne $package_file;
+
+ # set version to undef
+ my $version = (
+ $info->{'versions'}->{$package}
+ ? $info->{'versions'}->{$package}->stringify
+ : 0
+ );
+
+ $provides{$deb_name}->{$package} = $version;
+ }
+ }
+
+ remove_tree($tmp_dir);
+ }
+
+ # write PerlPackages.tmp
+ my $perl_packages_fh = IO::Any->write([$packages_dir, 'PerlPackages.tmp']);
+ foreach my $deb_name (sort keys %provides) {
+ die 'wrong package name - '.$deb_name
+ if $deb_name !~ m/^([^_]+) _ ([^_]+) _ ([^_]+) $/xms;
+ my ($package, $version, $arch) = ($1, $2, $3);
+
+ if ($provides{$deb_name}) {
+ print $perl_packages_fh 'Package: ', $package, "\n";
+
+ print
+ $perl_packages_fh
+ 'Architecture: ', $arch, "\n",
+ 'Filename: ', $deb_filenames{$deb_name}, "\n",
+ 'Version: ', $version, "\n",
+ (
+ $deb_to_src{$deb_filenames{$deb_name}}
+ ? ('Source: ', $deb_to_src{$deb_filenames{$deb_name}}, "\n")
+ : ()
+ ),
+ ;
+
+ my $perl_modules_count = scalar keys %{$provides{$deb_name}};
+ if ($perl_modules_count) {
+ print $perl_packages_fh
+ 'Perl-Modules: ',
+ ($perl_modules_count > 1 ? "\n " : ''),
+ (
+ join(
+ "\n ", map {
+ $_.' ('.$provides{$deb_name}->{$_}.')'
+ } keys %{$provides{$deb_name}}
+ )
+ ), "\n"
+ ;
+ }
+ }
+ else {
+ print $perl_packages_fh $deb_filenames{$deb_name};
+ }
+ print $perl_packages_fh "\n";
+ }
+
+ # create the PerlPackages.bz2
+ my $perl_packages = File::Spec->catfile($packages_dir, 'PerlPackages');
+ my $perl_packages_tmp = File::Spec->catfile($packages_dir, 'PerlPackages.tmp');
+ unlink $perl_packages_tmp.'.bz2'
+ if -f $perl_packages_tmp.'.bz2';
+ system('bzip2', '-9', $perl_packages_tmp) and die $!;
+ rename($perl_packages_tmp.'.bz2', $perl_packages.'.bz2') or die $!;
+ }
+
+ return 0;
+}
+
+sub _trim {
+ my $text = shift;
+ croak 'too much argauments' if @_;
+
+ $text =~ s/^\s+//xms;
+ $text =~ s/\s+$//xms;
+
+ return $text;
+}
+
+__END__
+
+=head1 AUTHOR
+
+Jozef Kutej
+
+=head1 COPYRIGHT
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Propchange: scripts/dpkg-scanpmpackages
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list