r1860 - in
packages/libparse-cpan-packages-perl/branches/upstream/current:
. lib/Parse/CPAN lib/Parse/CPAN/Packages t
Niko Tyni
ntyni-guest at costa.debian.org
Fri Jan 6 17:26:11 UTC 2006
Author: ntyni-guest
Date: 2006-01-06 17:26:10 +0000 (Fri, 06 Jan 2006)
New Revision: 1860
Modified:
packages/libparse-cpan-packages-perl/branches/upstream/current/Build.PL
packages/libparse-cpan-packages-perl/branches/upstream/current/CHANGES
packages/libparse-cpan-packages-perl/branches/upstream/current/META.yml
packages/libparse-cpan-packages-perl/branches/upstream/current/Makefile.PL
packages/libparse-cpan-packages-perl/branches/upstream/current/README
packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages.pm
packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages/Distribution.pm
packages/libparse-cpan-packages-perl/branches/upstream/current/t/02packages.details.txt.gz
packages/libparse-cpan-packages-perl/branches/upstream/current/t/simple.t
Log:
Load /tmp/tmp.SyK4yT/libparse-cpan-packages-perl-2.25 into
packages/libparse-cpan-packages-perl/branches/upstream/current.
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/Build.PL
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/Build.PL 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/Build.PL 2006-01-06 17:26:10 UTC (rev 1860)
@@ -9,8 +9,10 @@
'Class::Accessor::Fast' => 0,
'CPAN::DistnameInfo' => 0,
'IO::Zlib' => 0,
+ 'Sort::Versions' => 0,
+ },
+ build_requires => {
'Test::More' => 0,
- 'Sort::Versions' => 0,
-},
+ },
);
$build->create_build_script;
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/CHANGES
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/CHANGES 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/CHANGES 2006-01-06 17:26:10 UTC (rev 1860)
@@ -1,5 +1,15 @@
CHANGES file for Parse::CPAN::Packages
+2.25 Tue Jul 5 01:16:48 BST 2005
+ - fix bug where passing in the gz contents was not working
+
+2.24 Sun Feb 6 10:40:36 GMT 2005
+ - make the new() example in the docs work (spotted by Adam Kennedy)
+
+2.23 Sat Feb 5 17:20:48 GMT 2005
+ - the distribution() method is now documented
+ - remove an "undefined hash element" warning
+
2.21 Tue Jun 29 14:57:11 BST 2004
- now we're able to read the gzipped file directly (using IO::ZLib)
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/META.yml 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/META.yml 2006-01-06 17:26:10 UTC (rev 1860)
@@ -1,6 +1,6 @@
---- #YAML:1.0
+---
name: Parse-CPAN-Packages
-version: 2.21
+version: 2.25
author:
- Leon Brocard <acme at astray.com>
abstract: Parse 02packages.details.txt.gz
@@ -10,15 +10,16 @@
Class::Accessor::Fast: 0
IO::Zlib: 0
Sort::Versions: 0
+build_requires:
Test::More: 0
provides:
Parse::CPAN::Packages:
file: lib/Parse/CPAN/Packages.pm
- version: 2.21
+ version: 2.25
Parse::CPAN::Packages::Distribution:
file: lib/Parse/CPAN/Packages/Distribution.pm
version: 2.12
Parse::CPAN::Packages::Package:
file: lib/Parse/CPAN/Packages/Package.pm
version: 2.12
-generated_by: Module::Build version 0.25
+generated_by: Module::Build version 0.261
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/Makefile.PL 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/Makefile.PL 2006-01-06 17:26:10 UTC (rev 1860)
@@ -2,16 +2,16 @@
use ExtUtils::MakeMaker;
WriteMakefile
(
- 'PL_FILES' => {},
- 'INSTALLDIRS' => 'site',
'NAME' => 'Parse::CPAN::Packages',
'VERSION_FROM' => 'lib/Parse/CPAN/Packages.pm',
'PREREQ_PM' => {
- 'Test::More' => 0,
- 'IO::Zlib' => 0,
- 'Sort::Versions' => 0,
- 'Class::Accessor::Fast' => 0,
- 'CPAN::DistnameInfo' => 0
- }
+ 'CPAN::DistnameInfo' => '0',
+ 'Class::Accessor::Fast' => '0',
+ 'IO::Zlib' => '0',
+ 'Sort::Versions' => '0',
+ 'Test::More' => '0'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'PL_FILES' => {}
)
;
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/README
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/README 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/README 2006-01-06 17:26:10 UTC (rev 1860)
@@ -15,7 +15,7 @@
print $m->package, "\n"; # Acme::Colour
print $m->version, "\n"; # 1.00
- my $d = $p->distribution;
+ my $d = $m->distribution();
# $d is a Parse::CPAN::Packages::Distribution object
print $d->prefix, "\n"; # L/LB/LBROCARD/Acme-Colour-1.00.tar.gz
print $d->dist, "\n"; # Acme-Colour
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages/Distribution.pm
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages/Distribution.pm 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages/Distribution.pm 2006-01-06 17:26:10 UTC (rev 1860)
@@ -18,4 +18,9 @@
return @{ $self->packages };
}
+sub add_package {
+ my $self = shift;
+ push @{ $self->packages }, @_;
+}
+
1;
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages.pm
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages.pm 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/lib/Parse/CPAN/Packages.pm 2006-01-06 17:26:10 UTC (rev 1860)
@@ -3,95 +3,151 @@
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors(qw( details data dists latestdists ));
use CPAN::DistnameInfo;
+use Compress::Zlib;
use IO::Zlib;
use Parse::CPAN::Packages::Package;
use Sort::Versions;
use vars qw($VERSION);
-$VERSION = '2.21';
+$VERSION = '2.25';
sub new {
- my $class = shift;
- my $filename = shift;
+ my $class = shift;
- my $self = { dists => {}, latestdists => {} };
+ my $self = { data => {}, dists => {}, latestdists => {} };
bless $self, $class;
- $filename = '02packages.details.txt.gz' if not defined $filename;
+ # read the file then parse it if present
+ $self->parse(shift) if @_;
+ return $self;
+}
+
+# read the file into memory and return it
+sub _slurp_details {
+ my $self = shift;
+ my $filename = (@_) ? shift: "02packages.details.txt.gz";
+
if ($filename =~ /Description:/) {
- $self->details($filename);
+ return $filename;
} elsif ($filename =~ /\.gz/) {
-
- my $fh = IO::Zlib->new($filename, "rb") ||
- die "Failed to read $filename: $!";
- $self->details(join '', <$fh>);
- $fh->close;
+ my $fh = IO::Zlib->new($filename, "rb")
+ || die "Failed to read $filename: $!";
+ return join '', <$fh>;
+ } elsif ($filename =~ /^\037\213/) {
+ return Compress::Zlib::memGunzip($filename);
} else {
open(IN, $filename) || die "Failed to read $filename: $!";
- $self->details(join '', <IN>);
+ return join '', <IN>;
close(IN);
}
-
- $self->parse;
- return $self;
}
sub parse {
my $self = shift;
- my $details = $self->details;
+ my $details = $self->_slurp_details(shift);
+
+ # remove the preamble
$details = (split "\n\n", $details)[1];
- my $data;
- my $latestdists;
-
+ # run though each line of the file
foreach my $line (split "\n", $details) {
- my($package, $packageversion, $prefix) = split ' ', $line;
- my $m = Parse::CPAN::Packages::Package->new;
- $m->package($package);
- $m->version($packageversion);
- my $dist = $self->dists->{ $prefix } ||= do {
- my $d = Parse::CPAN::Packages::Distribution->new;
- my $i = CPAN::DistnameInfo->new($prefix);
- $d->prefix($prefix);
- $d->dist($i->dist);
- $d->version($i->version);
- $d->maturity($i->maturity);
- $d->filename($i->filename);
- $d->cpanid($i->cpanid);
- $d->distvname($i->distvname);
- $d;
- };
+ # make a package object from the line
+ my ($package_name, $package_version, $prefix) = split ' ', $line;
+ $self->add_quick($package_name, $package_version, $prefix);
+ }
+}
- $m->distribution($dist);
- push @{ $dist->packages }, $m;
+sub add_quick {
+ my $self = shift;
+ my ($package_name, $package_version, $prefix) = @_;
- push @{$latestdists->{$dist->dist}}, $dist if $dist->dist;
+ # create the package object
+ my $m = Parse::CPAN::Packages::Package->new;
+ $m->package($package_name);
+ $m->version($package_version);
- $data->{$package} = $m;
- }
- close(IN);
+ # create a distribution object (or get an existing one)
+ my $dist = $self->distribution_from_prefix($prefix);
- foreach my $dist (keys %$latestdists) {
- my @dists = @{$latestdists->{$dist}};
- my $highest_version = (sort { versioncmp($a->version || 0, $b->version || 0) } @dists)[-1];
- $self->latestdists->{$dist} = $highest_version;
- }
+ # make the package have the distribion and the distribution
+ # have the package. Yes, this creates a cirtular reference. eek!
+ $m->distribution($dist);
+ $dist->add_package($m);
- $self->data($data);
+ # record this distribution and package
+ $self->add_distribution($dist);
+ $self->add_package($m);
}
-sub package {
+sub distribution_from_prefix {
+ my $self = shift;
+ my $prefix = shift;
+
+ # see if we have one of these already and return it if we do.
+ my $d = $self->distribution($prefix);
+ return $d if $d;
+
+ # create a new one otherwise
+ $d = Parse::CPAN::Packages::Distribution->new;
+ my $i = CPAN::DistnameInfo->new($prefix);
+ $d->prefix($prefix);
+ $d->dist($i->dist);
+ $d->version($i->version);
+ $d->maturity($i->maturity);
+ $d->filename($i->filename);
+ $d->cpanid($i->cpanid);
+ $d->distvname($i->distvname);
+ return $d;
+}
+
+sub add_package {
my $self = shift;
my $package = shift;
- return $self->data->{$package};
+
+ # store it
+ $self->data->{ $package->package } = $package;
+
+ return $self;
}
+sub package {
+ my $self = shift;
+ my $package_name = shift;
+ return $self->data->{$package_name};
+}
+
sub packages {
my $self = shift;
- return values %{$self->data};
+ return values %{ $self->data };
}
+sub add_distribution {
+ my $self = shift;
+ my $dist = shift;
+
+ $self->_store_distribution($dist);
+ $self->_ensure_latest_distribution($dist);
+}
+
+sub _store_distribution {
+ my $self = shift;
+ my $dist = shift;
+
+ $self->dists->{ $dist->prefix } = $dist;
+}
+
+sub _ensure_latest_distribution {
+ my $self = shift;
+ local $a = shift;
+ local $b = $self->latest_distribution($a->dist);
+ if (!defined($b)
+ or versioncmp($a->version || 0, $b->version || 0) > 0)
+ {
+ $self->_set_latest_distribution($a);
+ }
+}
+
sub distribution {
my $self = shift;
my $dist = shift;
@@ -100,20 +156,43 @@
sub distributions {
my $self = shift;
- return values %{$self->dists};
+ return values %{ $self->dists };
}
+sub _set_latest_distribution {
+ my $self = shift;
+ my $dist = shift;
+ return unless $dist->dist;
+ $self->latestdists->{ $dist->dist } = $dist;
+}
+
sub latest_distribution {
my $self = shift;
my $dist = shift;
+ return unless $dist;
return $self->latestdists->{$dist};
}
sub latest_distributions {
my $self = shift;
- return values %{$self->latestdists};
+ return values %{ $self->latestdists };
}
+sub package_count {
+ my $self = shift;
+ return scalar scalar $self->packages;
+}
+
+sub distribution_count {
+ my $self = shift;
+ return scalar $self->distributions;
+}
+
+sub latest_distribution_count {
+ my $self = shift;
+ return scalar $self->latest_distributions;
+}
+
1;
__END__
@@ -137,7 +216,7 @@
print $m->package, "\n"; # Acme::Colour
print $m->version, "\n"; # 1.00
- my $d = $p->distribution;
+ my $d = $m->distribution();
# $d is a Parse::CPAN::Packages::Distribution object
print $d->prefix, "\n"; # L/LB/LBROCARD/Acme-Colour-1.00.tar.gz
print $d->dist, "\n"; # Acme-Colour
@@ -169,15 +248,121 @@
"modules" directory. This file contains lots of useful information and
this module provides a simple interface to the data contained within.
+In a future release L<Parse::CPAN::Packages::Package> and
+L<Parse::CPAN::Packages::Distribution> might have more information.
+
+=head2 Methods
+
+=over
+
+=item new
+
+Creates a new instance from a details file.
+
+The constructor can be passed either the path to the
+C<02packages.details.txt.gz> file, a path to an ungzipped version of
+this file, or a scalar containing the entire uncompressed contents of
+the file.
+
Note that this module does not concern itself with downloading this
-file. You should do this yourself.
+file. You should do this yourself. For example:
-The constructor takes the path to the 02packages.details.txt.gz
-file. It defaults to loading the file from the current directory.
+ use LWP::Simple qw(get);
+ my $data = get("http://www.cpan.org/modules/02packages.details.txt.gz");
+ my $p = Parse::CPAN::Packages->new($data);
-In a future release L<Parse::CPAN::Packages::Package> and
-L<Parse::CPAN::Packages::Distribution> might have more information.
+=item package($packagename)
+Returns a C<Parse::CPAN::Packages::Package> that represents the
+named package.
+
+ my $p = Parse::CPAN::Distribution->new($gzfilename);
+ my $package = $p->package("Acme::Colour");
+
+=item packages()
+
+Returns a list of B<Parse::CPAN::Packages::Package> objects
+representing all the packages that were extracted from the file.
+
+=item package_count()
+
+Returns the numebr of packages stored.
+
+=item distribution($filename)
+
+Returns a B<Parse::CPAN::Distribution> that represents the
+filename passed:
+
+ my $p = Parse::CPAN::Distribution->new($gzfilename);
+ my $dist = $p->distribution('L/LB/LBROCARD/Acme-Colour-1.00.tar.gz');
+
+=item distrbutions()
+
+Returns a list of B<Parse::CPAN::Distribution> objects representing
+all the known distributions.
+
+=item distribution_count()
+
+Returns the number of distributions stored.
+
+=item latest_distribution($distname)
+
+Returns the C<Parse::CPAN::Distribution> that represents the
+latest distribution for the named disribution passed, that is
+to say it returns the distribution that has the highest version
+number (as determined by Sort::Version):
+
+ my $p = Parse::CPAN::Distribution->new($gzfilename);
+ my $dist = $p->distribution('Acme-Color');
+
+=item latest_distrbutions()
+
+Returns a list of B<Parse::CPAN::Distribution> objects representing
+all the latest distributions.
+
+=item latest_distribution_count()
+
+Returns the number of distributions stored.
+
+=back
+
+=head2 Addtional Methods
+
+These are additional methods that you may find useful.
+
+=over
+
+=item parse($filename)
+
+Parses the filename. Works in a similar fashion to the the
+constructor (i.e. you can pass it a filename for a
+compressed/1uncompressed file, a uncompressed scalar containing the
+file. You can also pass nothing to indicate to load the compressed
+file from the current working directory.)
+
+Note that each time this function is run the packages and distribtions
+found will be C<added> to the current list of packages.
+
+=item add_quick($package_name, $package_version, $prefix)
+
+Quick way of adding a new package and distribution.
+
+=item add_package($package_obj)
+
+Adds a package. Note that you'll probably want to add the
+corrisponding distribution for that package too (it's not done
+automatically.)
+
+=item add_distribution($distribution_obj)
+
+Adds a distribution. Note that you'll probably want to add the
+corrisponding packages for that distribution too (it's not done
+automatically.)
+
+=cut
+
+=back
+
=head1 AUTHOR
Leon Brocard <acme at astray.com>
@@ -188,3 +373,22 @@
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
+
+=head1 BUGS
+
+This module leaks memory as packages hold distributions and
+distributions hold packages. No attempt has been made to fix this as
+it's not anticpated that this will be used in long running programs
+that will dispose of the objects once created.
+
+The old interface for C<new> where if you passed no arguments it would
+look for a C<02packages.details.txt.gz> in your current directory is
+no longer supported.
+
+=head1 TODO
+
+delete_* methods. merge_into method. Documentation for other modules.
+
+=head1 SEE ALSO
+
+L<CPAN::DistInfoname>, L<Parse::CPAN::Packages::Writer>.
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/t/02packages.details.txt.gz
===================================================================
(Binary files differ)
Modified: packages/libparse-cpan-packages-perl/branches/upstream/current/t/simple.t
===================================================================
--- packages/libparse-cpan-packages-perl/branches/upstream/current/t/simple.t 2006-01-06 17:07:33 UTC (rev 1859)
+++ packages/libparse-cpan-packages-perl/branches/upstream/current/t/simple.t 2006-01-06 17:26:10 UTC (rev 1860)
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
use strict;
use lib 'lib';
-use Test::More tests => 25;
+use Test::More tests => 30;
use_ok("Parse::CPAN::Packages");
my $p = Parse::CPAN::Packages->new("t/02packages.details.txt");
@@ -56,6 +56,11 @@
'X/XE/XERN/Acme-CramCode-0.01.tar.gz',
]);
+# counts
+is($p->package_count(), scalar @packages, "package count");
+is($p->distribution_count(), 7, "dist count");
+is($p->latest_distribution_count(), 6, "latest dist count");
+
open(IN, "t/02packages.details.txt");
my $details = join '', <IN>;
close(IN);
@@ -77,3 +82,16 @@
@packages = sort map { $_->package } $p->packages;
is_deeply(\@packages,
[qw(Acme::Colour Acme::Colour::Old Acme::ComeFrom Acme::Comment Acme::CramCode Acme::Currency accessors accessors::chained accessors::classic )]);
+
+# Try the interface which takes in gzipped contents
+
+open(IN, "t/02packages.details.txt.gz");
+$details = join '', <IN>;
+close(IN);
+
+$p = Parse::CPAN::Packages->new($details);
+isa_ok($p, "Parse::CPAN::Packages");
+
+ at packages = sort map { $_->package } $p->packages;
+is_deeply(\@packages,
+ [qw(Acme::Colour Acme::Colour::Old Acme::ComeFrom Acme::Comment Acme::CramCode Acme::Currency accessors accessors::chained accessors::classic )]);
More information about the Pkg-perl-cvs-commits
mailing list