r45280 - in /branches/upstream/libcpandb-perl/current: ./ inc/Module/Install/ lib/ lib/CPANDB/ script/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Oct 3 20:11:35 UTC 2009
Author: jawnsy-guest
Date: Sat Oct 3 20:11:29 2009
New Revision: 45280
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45280
Log:
[svn-upgrade] Integrating new upstream version, libcpandb-perl (0.11)
Added:
branches/upstream/libcpandb-perl/current/inc/Module/Install/Scripts.pm
branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pm
branches/upstream/libcpandb-perl/current/script/
branches/upstream/libcpandb-perl/current/script/cpangraph
Modified:
branches/upstream/libcpandb-perl/current/Changes
branches/upstream/libcpandb-perl/current/MANIFEST
branches/upstream/libcpandb-perl/current/META.yml
branches/upstream/libcpandb-perl/current/Makefile.PL
branches/upstream/libcpandb-perl/current/README
branches/upstream/libcpandb-perl/current/lib/CPANDB.pm
branches/upstream/libcpandb-perl/current/lib/CPANDB.pod
branches/upstream/libcpandb-perl/current/lib/CPANDB/Author.pod
branches/upstream/libcpandb-perl/current/lib/CPANDB/Dependency.pod
branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pod
branches/upstream/libcpandb-perl/current/lib/CPANDB/Module.pod
branches/upstream/libcpandb-perl/current/lib/CPANDB/Requires.pod
branches/upstream/libcpandb-perl/current/t/02_release.t
Modified: branches/upstream/libcpandb-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/Changes?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/Changes (original)
+++ branches/upstream/libcpandb-perl/current/Changes Sat Oct 3 20:11:29 2009
@@ -1,6 +1,38 @@
Changes for Perl extension CPANDB
-0.02 Thu 1 Jul 2009
+0.11 Thu 1 Oct 2009
+ - Updating ORLite::Statistics dependency to 0.03
+ - Adding basic implementation of age quadrants
+
+0.10 Sun 16 Aug 2009
+ - Integrating support for Statistics::Basic
+
+0.09 Thu 13 Aug 2009
+ - Typo, grr
+
+0.08 Thu 13 Aug 2009
+ - Ignore Task- modules in downstream dependants graphs
+
+0.07 Thu 13 Aug 2009
+ - Oopsi, typo
+
+0.06 Thu 13 Aug 2009
+ - Adding support for Graph::XGMML
+ - Adding support for downstream graphs
+
+0.05 Tue 21 Jul 2009
+ - Better, more varied, and more controllable graph support
+ - Added cpangraph command line graph generator
+ - Updated documentation to the newest schema
+
+0.04 Fri 3 Jul 2009
+ - Adding support for producing a Graph object for dependencies
+
+0.03 Thu 2 Jul 2009
+ - Removing superfluous indexes
+ - Prerun index stats for end user speed
+
+0.02 Thu 2 Jul 2009
- Updated to new URL.
- Generated a new version of the POD
Modified: branches/upstream/libcpandb-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/MANIFEST?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/MANIFEST (original)
+++ branches/upstream/libcpandb-perl/current/MANIFEST Sat Oct 3 20:11:29 2009
@@ -6,12 +6,14 @@
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
+inc/Module/Install/Scripts.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/CPANDB.pm
lib/CPANDB.pod
lib/CPANDB/Author.pod
lib/CPANDB/Dependency.pod
+lib/CPANDB/Distribution.pm
lib/CPANDB/Distribution.pod
lib/CPANDB/Module.pod
lib/CPANDB/Requires.pod
@@ -20,6 +22,7 @@
MANIFEST This list of files
META.yml
README
+script/cpangraph
t/01_compile.t
t/02_release.t
t/97_meta.t
Modified: branches/upstream/libcpandb-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/META.yml?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/META.yml (original)
+++ branches/upstream/libcpandb-perl/current/META.yml Sat Oct 3 20:11:29 2009
@@ -1,7 +1,7 @@
---
-abstract: 'A unified database for the CPAN index and related data'
+abstract: 'An ORLite-based ORM Database API'
author:
- - 'Adam Kennedy <adamk at cpan.org>'
+ - 'Adam Kennedy.'
build_requires:
ExtUtils::MakeMaker: 6.42
LWP::Online: 1.07
@@ -21,11 +21,16 @@
- inc
- t
requires:
+ DateTime: 0.50
+ Getopt::Long: 2.33
+ ORLite: 1.25
ORLite::Mirror: 1.15
+ ORLite::Statistics: 0.03
Params::Util: 1.00
+ Time::HiRes: 1.97
perl: 5.8.5
resources:
ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/CPANDB
license: http://dev.perl.org/licenses/
repository: http://svn.ali.as/cpan/trunk/CPANDB
-version: 0.02
+version: 0.11
Modified: branches/upstream/libcpandb-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/Makefile.PL?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/Makefile.PL (original)
+++ branches/upstream/libcpandb-perl/current/Makefile.PL Sat Oct 3 20:11:29 2009
@@ -1,6 +1,13 @@
use inc::Module::Install::DSL 0.91;
-all_from lib/CPANDB.pm
-requires_from lib/CPANDB.pm
-test_requires Test::More 0.42
-test_requires LWP::Online 1.07
+all_from lib/CPANDB.pm
+requires Getopt::Long 2.33
+requires Time::HiRes 1.97
+requires Params::Util 1.00
+requires DateTime 0.50
+requires ORLite 1.25
+requires ORLite::Mirror 1.15
+requires ORLite::Statistics 0.03
+test_requires Test::More 0.42
+test_requires LWP::Online 1.07
+install_script cpangraph
Modified: branches/upstream/libcpandb-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/README?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/README (original)
+++ branches/upstream/libcpandb-perl/current/README Sat Oct 3 20:11:29 2009
@@ -1,5 +1,5 @@
NAME
- CPANDB - A unified database for the CPAN index and related data
+ CPANDB - An ORLite-based ORM Database API
SYNOPSIS
TO BE COMPLETED
@@ -9,13 +9,13 @@
METHODS
dsn
- my $string = Foo::Bar->dsn;
+ my $string = CPANDB->dsn;
- The "dsn" accessor returns the dbi connection string used to connect to
+ The "dsn" accessor returns the DBI connection string used to connect to
the SQLite database as a string.
dbh
- my $handle = Foo::Bar->dbh;
+ my $handle = CPANDB->dbh;
To reliably prevent potential SQLite deadlocks resulting from multiple
connections in a single process, each ORLite package will only ever
@@ -25,11 +25,11 @@
Although in most situations you should not need a direct DBI connection
handle, the "dbh" method provides a method for getting a direct
- connection in a way that is compatible with ORLite's connection
- management.
+ connection in a way that is compatible with connection management in
+ ORLite.
Please note that these connections should be short-lived, you should
- never hold onto a connection beyond the immediate scope.
+ never hold onto a connection beyond your immediate scope.
The transaction system in ORLite is specifically designed so that code
using the database should never have to know whether or not it is in a
@@ -112,21 +112,18 @@
pragma
# Get the user_version for the schema
- my $version = Foo::Bar->pragma('user_version');
+ my $version = CPANDB->pragma('user_version');
The "pragma" method provides a convenient method for fetching a pragma
for a datase. See the SQLite documentation for more details.
SUPPORT
- CPANDB is based on ORLite 1.22.
+ CPANDB is based on ORLite 1.23.
Documentation created by ORLite::Pod 0.06.
For general support please see the support section of the main project
documentation.
-
-AUTHOR
- Adam Kennedy <adamk at cpan.org>
COPYRIGHT
Copyright 2009 Adam Kennedy.
Added: branches/upstream/libcpandb-perl/current/inc/Module/Install/Scripts.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/inc/Module/Install/Scripts.pm?rev=45280&op=file
==============================================================================
--- branches/upstream/libcpandb-perl/current/inc/Module/Install/Scripts.pm (added)
+++ branches/upstream/libcpandb-perl/current/inc/Module/Install/Scripts.pm Sat Oct 3 20:11:29 2009
@@ -1,0 +1,29 @@
+#line 1
+package Module::Install::Scripts;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub install_script {
+ my $self = shift;
+ my $args = $self->makemaker_args;
+ my $exe = $args->{EXE_FILES} ||= [];
+ foreach ( @_ ) {
+ if ( -f $_ ) {
+ push @$exe, $_;
+ } elsif ( -d 'script' and -f "script/$_" ) {
+ push @$exe, "script/$_";
+ } else {
+ die("Cannot find script '$_'");
+ }
+ }
+}
+
+1;
Modified: branches/upstream/libcpandb-perl/current/lib/CPANDB.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB.pm?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB.pm (original)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB.pm Sat Oct 3 20:11:29 2009
@@ -3,17 +3,19 @@
use 5.008005;
use strict;
use warnings;
-use Params::Util 1.00 ();
-use ORLite::Mirror 1.15 ();
+use IO::File ();
+use Params::Util ();
+use ORLite::Mirror ();
+use CPANDB::Distribution ();
-our $VERSION = '0.02';
+our $VERSION = '0.11';
sub import {
- my $class = shift;
+ my $class = shift;
my $params = Params::Util::_HASH(shift) || {};
# Pass through any params from above
- $params->{url} ||= 'http://svn.ali.as/db/cpandb.gz';
+ $params->{url} ||= 'http://svn.ali.as/db/cpandb.bz2';
$params->{maxage} ||= 24 * 60 * 60; # One day
# Prevent double-initialisation
@@ -23,4 +25,67 @@
return 1;
}
+sub distribution {
+ my $self = shift;
+ my @dist = CPANDB::Distribution->select(
+ 'where distribution = ?', $_[0],
+ );
+ unless ( @dist ) {
+ die("Distribution '$_[0]' does not exist");
+ }
+ return $dist[0];
+}
+
+sub graph {
+ require Graph;
+ require Graph::Directed;
+ my $class = shift;
+ my $graph = Graph::Directed->new;
+ foreach my $vertex ( CPANDB::Distribution->select ) {
+ $graph->add_vertex( $vertex->distribution );
+ }
+ foreach my $edge ( CPANDB::Dependency->select ) {
+ $graph->add_edge( $edge->distribution => $edge->dependency );
+ }
+ return $graph;
+}
+
+sub easy {
+ require Graph::Easy;
+ my $class = shift;
+ my $graph = Graph::Easy->new;
+ foreach my $vertex ( CPANDB::Distribution->select ) {
+ $graph->add_vertex( $vertex->distribution );
+ }
+ foreach my $edge ( CPANDB::Dependency->select ) {
+ $graph->add_edge( $edge->distribution => $edge->dependency );
+ }
+ return $graph;
+}
+
+sub xgmml {
+ require Graph::XGMML;
+ my $class = shift;
+ my @param = ( @_ == 1 ) ? ( OUTPUT => IO::File->new( shift, 'w' ) ) : ( @_ );
+ my $graph = Graph::XGMML->new( directed => 1, @param );
+ foreach my $vertex ( CPANDB::Distribution->select ) {
+ $graph->add_vertex( $vertex->distribution );
+ }
+ foreach my $edge ( CPANDB::Dependency->select ) {
+ $graph->add_edge( $edge->distribution => $edge->dependency );
+ }
+ $graph->end;
+ return 1;
+}
+
+sub csv {
+ my $class = shift;
+ my $file = shift;
+ my $csv = IO::File->new($file, 'w');
+ foreach my $edge ( CPANDB::Dependency->select ) {
+ $csv->print( $edge->distribution . "\t" . $edge->dependency . "\n" );
+ }
+ $csv->close;
+}
+
1;
Modified: branches/upstream/libcpandb-perl/current/lib/CPANDB.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB.pod?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB.pod (original)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB.pod Sat Oct 3 20:11:29 2009
@@ -1,6 +1,6 @@
=head1 NAME
-CPANDB - A unified database for the CPAN index and related data
+CPANDB - An ORLite-based ORM Database API
=head1 SYNOPSIS
@@ -14,16 +14,16 @@
=head2 dsn
- my $string = Foo::Bar->dsn;
+ my $string = CPANDB->dsn;
-The C<dsn> accessor returns the dbi connection string used to connect
+The C<dsn> accessor returns the L<DBI> connection string used to connect
to the SQLite database as a string.
=head2 dbh
- my $handle = Foo::Bar->dbh;
+ my $handle = CPANDB->dbh;
-To reliably prevent potential SQLite deadlocks resulting from multiple
+To reliably prevent potential L<SQLite> deadlocks resulting from multiple
connections in a single process, each ORLite package will only ever
maintain a single connection to the database.
@@ -31,11 +31,11 @@
Although in most situations you should not need a direct DBI connection
handle, the C<dbh> method provides a method for getting a direct
-connection in a way that is compatible with ORLite's connection
-management.
+connection in a way that is compatible with connection management in
+L<ORLite>.
Please note that these connections should be short-lived, you should
-never hold onto a connection beyond the immediate scope.
+never hold onto a connection beyond your immediate scope.
The transaction system in ORLite is specifically designed so that code
using the database should never have to know whether or not it is in a
@@ -126,23 +126,19 @@
=head2 pragma
# Get the user_version for the schema
- my $version = Foo::Bar->pragma('user_version');
+ my $version = CPANDB->pragma('user_version');
The C<pragma> method provides a convenient method for fetching a pragma
for a datase. See the SQLite documentation for more details.
=head1 SUPPORT
-CPANDB is based on L<ORLite> 1.22.
+CPANDB is based on L<ORLite> 1.23.
Documentation created by L<ORLite::Pod> 0.06.
For general support please see the support section of the main
project documentation.
-
-=head1 AUTHOR
-
-Adam Kennedy E<lt>adamk at cpan.orgE<gt>
=head1 COPYRIGHT
Modified: branches/upstream/libcpandb-perl/current/lib/CPANDB/Author.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB/Author.pod?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB/Author.pod (original)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB/Author.pod Sat Oct 3 20:11:29 2009
@@ -32,7 +32,8 @@
compatible with SQLite can be used in the parameter.
Returns a list of B<CPANDB::Author> objects when called in list context, or a
-reference to an ARRAY of B<CPANDB::Author> objects when called in scalar context.
+reference to an C<ARRAY> of B<CPANDB::Author> objects when called in scalar
+ context.
Throws an exception on error, typically directly from the L<DBI> layer.
@@ -80,19 +81,16 @@
following SQL command.
CREATE TABLE author (
- author TEXT NOT NULL PRIMARY KEY,
- name TEXT NOT NULL
+ author TEXT NOT NULL PRIMARY KEY,
+ name TEXT NOT NULL
)
+
=head1 SUPPORT
CPANDB::Author is part of the L<CPANDB> API.
See the documentation for L<CPANDB> for more information.
-
-=head1 AUTHOR
-
-Adam Kennedy
=head1 COPYRIGHT
Modified: branches/upstream/libcpandb-perl/current/lib/CPANDB/Dependency.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB/Dependency.pod?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB/Dependency.pod (original)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB/Dependency.pod Sat Oct 3 20:11:29 2009
@@ -32,7 +32,8 @@
compatible with SQLite can be used in the parameter.
Returns a list of B<CPANDB::Dependency> objects when called in list context, or a
-reference to an ARRAY of B<CPANDB::Dependency> objects when called in scalar context.
+reference to an C<ARRAY> of B<CPANDB::Dependency> objects when called in scalar
+ context.
Throws an exception on error, typically directly from the L<DBI> layer.
@@ -80,23 +81,37 @@
following SQL command.
CREATE TABLE dependency (
- distribution TEXT NOT NULL,
- dependency TEXT NOT NULL,
- phase TEXT NOT NULL,
- PRIMARY KEY ( distribution, dependency, phase ),
- FOREIGN KEY ( distribution ) REFERENCES distribition ( distribution ),
- FOREIGN KEY ( dependency ) REFERENCES distribution ( distribution )
+ distribution TEXT NOT NULL,
+ dependency TEXT NOT NULL,
+ phase TEXT NOT NULL,
+ core REAL NULL,
+ PRIMARY KEY (
+ distribution,
+ dependency,
+ phase
+ )
+ ,
+ FOREIGN KEY (
+ distribution
+ )
+ REFERENCES distribition (
+ distribution
+ )
+ ,
+ FOREIGN KEY (
+ dependency
+ )
+ REFERENCES distribution (
+ distribution
+ )
)
+
=head1 SUPPORT
CPANDB::Dependency is part of the L<CPANDB> API.
See the documentation for L<CPANDB> for more information.
-
-=head1 AUTHOR
-
-Adam Kennedy
=head1 COPYRIGHT
Added: branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pm?rev=45280&op=file
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pm (added)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pm Sat Oct 3 20:11:29 2009
@@ -1,0 +1,250 @@
+package CPANDB::Distribution;
+
+use 5.008005;
+use strict;
+use warnings;
+use DateTime ();
+use ORLite::Statistics;
+
+our $VERSION = '0.11';
+
+my $today = DateTime->today( time_zone => 'UTC' );
+
+
+
+
+
+######################################################################
+# DateTime Integration
+
+sub uploaded_datetime {
+ my $self = shift;
+ my @date = split(/-/, $self->uploaded);
+ DateTime->new(
+ year => $date[0],
+ month => $date[1],
+ day => $date[2],
+ locale => 'C',
+ time_zone => 'UTC',
+ );
+}
+
+sub age {
+ $today - $_[0]->uploaded_datetime;
+}
+
+sub age_months {
+ $_[0]->age->in_units('months');
+}
+
+sub quadrant {
+ my $self = shift;
+
+ # Get the boundary dates
+ my @quadrant = ref($self)->_quadrant;
+
+ # Find which quadrant we are in
+ my $uploaded = $self->uploaded;
+ if ( $uploaded gt $quadrant[0] ) {
+ return 1;
+ } elsif ( $uploaded gt $quadrant[1] ) {
+ return 2;
+ } elsif ( $uploaded gt $quadrant[2] ) {
+ return 3;
+ } else {
+ return 4;
+ }
+}
+
+my @QUADRANT = ();
+
+sub _quadrant {
+ return @QUADRANT if @QUADRANT;
+
+ # Start with the total number of distributions
+ my $class = shift;
+ my $rows = $class->count;
+ my $mod = $rows % 4;
+ my $range = ($rows - $mod) / 4;
+
+ # Find the last row in each quadrant
+ foreach ( 1 .. 4 ) {
+ my $offset = ($range * $_) + $mod - 1;
+
+ # Tweak the boundary rows to deal with row totals
+ # that are not divisible by four. By generous about
+ # moving edge cases up if so.
+ if ( $mod - $_ > 0 ) {
+ $offset = $offset - ( $mod - $_ );
+ }
+
+ # Find the upload date for the resulting row
+ my @object = $class->select("order by uploaded desc limit 1 offset $offset");
+ unless ( @object == 1 ) {
+ die("Failed to find edge of quadrant $_");
+ }
+
+ push @QUADRANT, $object[0]->uploaded;
+ }
+
+ return @QUADRANT;
+}
+
+
+
+
+
+######################################################################
+# Graph Integration
+
+sub dependency_graph {
+ require Graph::Directed;
+ shift->_dependency( _class => 'Graph::Directed', @_ );
+}
+
+sub dependants_graph {
+ require Graph::Directed;
+ shift->_dependants( _class => 'Graph::Directed', @_ );
+}
+
+sub dependency_easy {
+ require Graph::Easy;
+ shift->_dependency( _class => 'Graph::Easy', @_ );
+}
+
+sub dependants_easy {
+ require Graph::Easy;
+ shift->_dependants( _class => 'Graph::Easy', @_ );
+}
+
+sub dependency_graphviz {
+ require GraphViz;
+ shift->_dependency( _class => 'GraphViz', @_ );
+}
+
+sub dependants_graphviz {
+ require GraphViz;
+ shift->_dependants( _class => 'GraphViz', @_ );
+}
+
+sub dependency_xgmml {
+ require Graph::XGMML;
+ my $self = shift;
+ my @param = ( @_ == 1 ) ? ( OUTPUT => IO::File->new( shift, 'w' ) ) : ( @_ );
+ $self->_dependency( _class => 'Graph::XGMML', @param );
+}
+
+sub dependants_xgmml {
+ require Graph::XGMML;
+ my $self = shift;
+ my @param = ( @_ == 1 ) ? ( OUTPUT => IO::File->new( shift, 'w' ) ) : ( @_ );
+ $self->_dependants( _class => 'Graph::XGMML', @param );
+}
+
+sub _dependency {
+ my $self = shift;
+ my %param = @_;
+ my $class = delete $param{_class};
+ my $phase = delete $param{phase};
+ my $perl = delete $param{perl};
+
+ # Prepare support values for the algorithm
+ my $add_node = $class->can('add_vertex')
+ ? 'add_vertex'
+ : 'add_node';
+ my $sql_where = 'where distribution = ?';
+ my @sql_param = ();
+ if ( $phase ) {
+ $sql_where .= ' and phase = ?';
+ push @sql_param, $phase;
+ }
+ if ( $perl ) {
+ $sql_where .= ' and ( core is null or core >= ? )';
+ push @sql_param, $perl;
+ }
+
+ # Pass any remaining params to the graph constructor
+ my $graph = $class->new( %param );
+
+ # Fill the graph via simple list recursion
+ my @todo = ( $self->distribution );
+ my %seen = ( $self->distribution => 1 );
+ while ( @todo ) {
+ my $name = shift @todo;
+ $graph->$add_node( $name );
+
+ # Find the distinct dependencies for this node
+ my %edge = ();
+ my @deps = grep {
+ not $edge{$_}++
+ } map {
+ $_->dependency
+ } CPANDB::Dependency->select(
+ $sql_where, $name, @sql_param,
+ );
+ foreach my $dep ( @deps ) {
+ $graph->add_edge( $name => $dep );
+ }
+
+ # Push the new ones to the list
+ push @todo, grep { not $seen{$_}++ } @deps;
+ }
+
+ return $graph;
+}
+
+sub _dependants {
+ my $self = shift;
+ my %param = @_;
+ my $class = delete $param{_class};
+ my $phase = delete $param{phase};
+ my $perl = delete $param{perl};
+
+ # Prepare support values for the algorithm
+ my $add_node = $class->can('add_vertex') ? 'add_vertex' : 'add_node';
+ my $sql_where = 'where dependency = ?';
+ my @sql_param = ();
+ if ( $phase ) {
+ $sql_where .= ' and phase = ?';
+ push @sql_param, $phase;
+ }
+ if ( $perl ) {
+ $sql_where .= ' and ( core is null or core >= ? )';
+ push @sql_param, $perl;
+ }
+
+ # Pass any remaining params to the graph constructor
+ my $graph = $class->new( %param );
+
+ # Fill the graph via simple list recursion
+ my @todo = ( $self->distribution );
+ my %seen = ( $self->distribution => 1 );
+ while ( @todo ) {
+ my $name = shift @todo;
+ next if $name =~ /^Task-/;
+ next if $name =~ /^Acme-Mom/;
+ $graph->$add_node( $name );
+
+ # Find the distinct dependencies for this node
+ my %edge = ();
+ my @deps = grep {
+ not $edge{$_}++
+ } map {
+ $_->distribution
+ } CPANDB::Dependency->select(
+ $sql_where, $name, @sql_param,
+ );
+ foreach my $dep ( @deps ) {
+ next if $dep =~ /^Task-/;
+ next if $dep =~ /^Acme-Mom/;
+ $graph->add_edge( $name => $dep );
+ }
+
+ # Push the new ones to the list
+ push @todo, grep { not $seen{$_}++ } @deps;
+ }
+
+ return $graph;
+}
+
+1;
Modified: branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pod?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pod (original)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB/Distribution.pod Sat Oct 3 20:11:29 2009
@@ -32,7 +32,8 @@
compatible with SQLite can be used in the parameter.
Returns a list of B<CPANDB::Distribution> objects when called in list context, or a
-reference to an ARRAY of B<CPANDB::Distribution> objects when called in scalar context.
+reference to an C<ARRAY> of B<CPANDB::Distribution> objects when called in scalar
+ context.
Throws an exception on error, typically directly from the L<DBI> layer.
@@ -80,23 +81,35 @@
following SQL command.
CREATE TABLE distribution (
- distribution TEXT NOT NULL PRIMARY KEY,
- version TEXT NULL,
- author TEXT NOT NULL,
- release TEXT NOT NULL,
- uploaded TEXT NOT NULL,
- FOREIGN KEY ( author ) REFERENCES author ( author )
+ distribution TEXT NOT NULL PRIMARY KEY,
+ version TEXT NULL,
+ author TEXT NOT NULL,
+ meta INTEGER NOT NULL,
+ license TEXT NULL,
+ release TEXT NOT NULL,
+ uploaded TEXT NOT NULL,
+ pass INTEGER NOT NULL,
+ fail INTEGER NOT NULL,
+ unknown INTEGER NOT NULL,
+ na INTEGER NOT NULL,
+ rating TEXT NULL,
+ ratings INTEGER NOT NULL,
+ weight INTEGER NOT NULL,
+ volatility INTEGER NOT NULL,
+ FOREIGN KEY (
+ author
+ )
+ REFERENCES author (
+ author
+ )
)
+
=head1 SUPPORT
CPANDB::Distribution is part of the L<CPANDB> API.
See the documentation for L<CPANDB> for more information.
-
-=head1 AUTHOR
-
-Adam Kennedy
=head1 COPYRIGHT
Modified: branches/upstream/libcpandb-perl/current/lib/CPANDB/Module.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB/Module.pod?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB/Module.pod (original)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB/Module.pod Sat Oct 3 20:11:29 2009
@@ -32,7 +32,8 @@
compatible with SQLite can be used in the parameter.
Returns a list of B<CPANDB::Module> objects when called in list context, or a
-reference to an ARRAY of B<CPANDB::Module> objects when called in scalar context.
+reference to an C<ARRAY> of B<CPANDB::Module> objects when called in scalar
+ context.
Throws an exception on error, typically directly from the L<DBI> layer.
@@ -80,21 +81,23 @@
following SQL command.
CREATE TABLE module (
- module TEXT NOT NULL PRIMARY KEY,
- version TEXT NULL,
- distribution TEXT NOT NULL,
- FOREIGN KEY ( distribution ) REFERENCES distribution ( distribution )
+ module TEXT NOT NULL PRIMARY KEY,
+ version TEXT NULL,
+ distribution TEXT NOT NULL,
+ FOREIGN KEY (
+ distribution
+ )
+ REFERENCES distribution (
+ distribution
+ )
)
+
=head1 SUPPORT
CPANDB::Module is part of the L<CPANDB> API.
See the documentation for L<CPANDB> for more information.
-
-=head1 AUTHOR
-
-Adam Kennedy
=head1 COPYRIGHT
Modified: branches/upstream/libcpandb-perl/current/lib/CPANDB/Requires.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/lib/CPANDB/Requires.pod?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/lib/CPANDB/Requires.pod (original)
+++ branches/upstream/libcpandb-perl/current/lib/CPANDB/Requires.pod Sat Oct 3 20:11:29 2009
@@ -32,7 +32,8 @@
compatible with SQLite can be used in the parameter.
Returns a list of B<CPANDB::Requires> objects when called in list context, or a
-reference to an ARRAY of B<CPANDB::Requires> objects when called in scalar context.
+reference to an C<ARRAY> of B<CPANDB::Requires> objects when called in scalar
+ context.
Throws an exception on error, typically directly from the L<DBI> layer.
@@ -80,24 +81,37 @@
following SQL command.
CREATE TABLE requires (
- distribution TEXT NOT NULL,
- module TEXT NOT NULL,
- version TEXT NULL,
- phase TEXT NOT NULL,
- PRIMARY KEY ( distribution, module, phase ),
- FOREIGN KEY ( distribution ) REFERENCES distribution ( distribution ),
- FOREIGN KEY ( module ) REFERENCES module ( module )
+ distribution TEXT NOT NULL,
+ module TEXT NOT NULL,
+ version TEXT NULL,
+ phase TEXT NOT NULL,
+ PRIMARY KEY (
+ distribution,
+ module,
+ phase
+ )
+ ,
+ FOREIGN KEY (
+ distribution
+ )
+ REFERENCES distribution (
+ distribution
+ )
+ ,
+ FOREIGN KEY (
+ module
+ )
+ REFERENCES module (
+ module
+ )
)
+
=head1 SUPPORT
CPANDB::Requires is part of the L<CPANDB> API.
See the documentation for L<CPANDB> for more information.
-
-=head1 AUTHOR
-
-Adam Kennedy
=head1 COPYRIGHT
Added: branches/upstream/libcpandb-perl/current/script/cpangraph
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/script/cpangraph?rev=45280&op=file
==============================================================================
--- branches/upstream/libcpandb-perl/current/script/cpangraph (added)
+++ branches/upstream/libcpandb-perl/current/script/cpangraph Sat Oct 3 20:11:29 2009
@@ -1,0 +1,57 @@
+#!/usr/bin/perl
+
+use 5.008005;
+use strict;
+use warnings;
+use Time::HiRes ();
+use Getopt::Long ();
+
+our $VERSION = '0.11';
+
+use CPANDB ();
+
+# Check params
+my $PERL = undef;
+my $PHASE = undef;
+my $VERBOSE = 0;
+my $RANKDIR = 0;
+my $REVERSE = 0;
+Getopt::Long::GetOptions(
+ 'perl=s' => \$PERL,
+ 'phase=s' => \$PHASE,
+ 'verbose' => \$VERBOSE,
+ 'rankdir' => \$RANKDIR,
+ 'reverse' => \$REVERSE,
+) or die "Failed to parse options";
+
+# Find the distribution
+my $name = shift @ARGV;
+unless ( $name ) {
+ print "Did not provide a distribution name\n";
+ exit(0);
+}
+
+# Load the database and fine the distribution
+CPANDB->import( {
+ show_progress => $VERBOSE,
+} );
+my $dist = CPANDB->distribution($name);
+
+# Determine the graph file name
+my $file = $name;
+if ( $PHASE ) {
+ $file .= '-' . $PHASE;
+}
+if ( $PERL ) {
+ $file .= '-' . $PERL;
+}
+
+# Generate the graph
+my $method = $REVERSE
+ ? 'dependants_graphviz'
+ : 'dependency_graphviz';
+$dist->$method(
+ perl => $PERL,
+ phase => $PHASE,
+ rankdir => $RANKDIR,
+)->as_svg("$file.svg");
Modified: branches/upstream/libcpandb-perl/current/t/02_release.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcpandb-perl/current/t/02_release.t?rev=45280&op=diff
==============================================================================
--- branches/upstream/libcpandb-perl/current/t/02_release.t (original)
+++ branches/upstream/libcpandb-perl/current/t/02_release.t Sat Oct 3 20:11:29 2009
@@ -7,12 +7,123 @@
}
use Test::More;
-use LWP::Online ':skip_all';
unless ( $ENV{RELEASE_TESTING} ) {
plan( skip_all => "Author tests not required for installation" );
exit(0);
}
-plan( tests => 1 );
+plan( tests => 32 );
+# Download and load the database
use_ok( 'CPANDB' );
+
+
+
+
+
+######################################################################
+# CPANDB shortcuts
+
+my $d = CPANDB->distribution('Config-Tiny');
+isa_ok( $d, 'CPANDB::Distribution' );
+isa_ok( $d->uploaded_datetime, 'DateTime' );
+isa_ok( $d->age, 'DateTime::Duration' );
+
+
+
+
+
+######################################################################
+# Graph.pm Integration
+
+eval {
+ require Graph;
+};
+SKIP: {
+ skip("No Graph support available", 3) if $@;
+
+ # Graph generation for the entire grap
+ SCOPE: {
+ my $graph = CPANDB->graph;
+ isa_ok( $graph, 'Graph::Directed' );
+ }
+
+ # Graph generation for a single distribution
+ SCOPE: {
+ my $graph1 = $d->dependency_graph;
+ isa_ok( $graph1, 'Graph::Directed' );
+
+ my $graph2 = $d->dependency_graph( phase => 'runtime' );
+ isa_ok( $graph2, 'Graph::Directed' );
+ }
+}
+
+
+
+
+
+######################################################################
+# Graph::Easy Integration
+
+eval {
+ require Graph::Easy;
+};
+SKIP: {
+ skip("No Graph::Easy support available", 1) if $@;
+
+ # Graph::Easy generation for a single distribution
+ SCOPE: {
+ my $graph = $d->dependency_easy;
+ isa_ok( $graph, 'Graph::Easy' );
+ }
+}
+
+
+
+
+
+######################################################################
+# GraphViz Integration
+
+eval {
+ require GraphViz;
+};
+SKIP: {
+ skip("No GraphViz support available", 1) if $@;
+
+ # GraphViz generation for a single distribution
+ SCOPE: {
+ my $graph = $d->dependency_graphviz;
+ isa_ok( $graph, 'GraphViz' );
+ }
+}
+
+
+
+
+
+######################################################################
+# Quadrant Support
+
+SCOPE: {
+ my @latest = CPANDB::Distribution->select("order by uploaded desc limit 10");
+ is( scalar(@latest), 10, 'Found the 10 latest results' );
+ foreach ( @latest ) {
+ isa_ok( $_, 'CPANDB::Distribution' );
+ is( $_->quadrant, 1, $_->distribution . ' is in quadrant 1' );
+ }
+}
+
+
+
+
+
+######################################################################
+# Statistics Support
+
+SCOPE: {
+ my $vector = CPANDB::Distribution->vector('weight');
+ isa_ok( $vector, 'Statistics::Basic::Vector' );
+ my $age = CPANDB::Distribution->vector('age_months');
+ isa_ok( $vector, 'Statistics::Basic::Vector' );
+}
More information about the Pkg-perl-cvs-commits
mailing list