r28044 - in /trunk/dh-make-perl: dh-make-perl lib/Debian/Dependency.pm t/Dep.t

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Thu Dec 11 08:08:54 UTC 2008


Author: dmn
Date: Thu Dec 11 08:08:52 2008
New Revision: 28044

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28044
Log:
move Deb into Debian::Dependency

Added:
    trunk/dh-make-perl/lib/Debian/Dependency.pm
Modified:
    trunk/dh-make-perl/dh-make-perl
    trunk/dh-make-perl/t/Dep.t

Modified: trunk/dh-make-perl/dh-make-perl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/dh-make-perl?rev=28044&op=diff
==============================================================================
--- trunk/dh-make-perl/dh-make-perl (original)
+++ trunk/dh-make-perl/dh-make-perl Thu Dec 11 08:08:52 2008
@@ -90,123 +90,6 @@
     return $seq_argument;
 }
 
-# The C<Dep> class represent a dependency relationship in an opaque way
-#
-# SYNOPSIS
-#
-#   my $d = Dep->new( 'perl' );             # simple dependency
-#   my $d = Dep->new('perl (>= 5.10)');     # also parses a single argument
-#   my $d = Dep->new( 'perl', '5.10' );     # dependency with a version
-#   my $d = Dep->new( 'perl', '>=', '5.10' );
-#                               # dependency with version and relation
-#   print $d->pkg;  # 'perl'
-#   print $d->ver;  # '5.10
-#
-#                                   # for people who like to type much
-#   my $d = Dep->new( { pkg => 'perl', ver => '5.10' } );
-#
-#   # stringification
-#   print "$d"      # 'perl (>= 5.10)'
-#
-#   # parsing lists
-#   my @list = Dep->parse_list( 'perl (>= 5.10), libc (>= 2.7)' );
-#   print $list[0]->ver;    # '5.10'
-#
-#                                                       # <= relationship
-#   my @list = Dep->parse_list( 'perl (<= 5.11)' );     # UNSUPPORTED
-#
-package Dep;
-
-use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw( pkg ver rel ));
-
-use overload
-    '""'    => \&stringify;
-sub new {
-    my $class = shift;
-    $class = ref($class) if ref($class);
-
-    return $class->SUPER::new(@_) if ref( $_[0] );
-
-    return $class->parse( $_[0] )
-        if @_ == 1;
-
-    return $class->SUPER::new( { pkg => $_[0], rel => '>=', ver => $_[1] } )
-        if @_ == 2;
-
-    return $class->SUPER::new( { pkg => $_[0], rel => $_[1], ver => $_[2] } )
-        if @_ == 3;
-
-    die "Unsupported number of arguments";
-}
-
-sub stringify {
-    my $self = shift;
-
-    return (
-        $self->ver
-        ? $self->pkg . ' (' . $self->rel . ' ' . $self->ver . ')'
-        : $self->pkg
-    );
-}
-
-sub parse {
-    my ( $class, $str ) = @_;
-
-    if ( $str =~ m{
-            ^               # start from the beginning
-            ([^\(\s]+)      # package name - no paren, no space
-            \s*             # oprional space
-            (?:             # version is optional
-                \(          # opening paren
-                    (       # various relations 
-                        <<
-                      | <=
-                      | ==
-                      | >=
-                      | >>
-                    )
-                    \s*     # optional space
-                    (.+)    # version
-                \)          # closing paren
-            )?
-            $}x             # done
-    )
-    {
-        return $class->new( {
-            pkg => $1,
-            ( ( defined($2) and defined($3) )
-               ? ( rel => $2, ver => $3 )
-               : ()
-            )
-        } );
-    }
-    else {
-        die "Unable to parse '$str'";
-    }
-}
-
-sub parse_list {
-    my $class = shift;
-    my @list = split( /\s*,\s*/, shift );
-
-    for( @list ) {
-        if ( /(^S+)\s(.+)$/ ) {
-            my ( $pkg, $ver ) = ( $1, $2 );
-            $ver =~ s/^>=\s*//
-                or die "$_: only '>=' relationships are supported";
-            $_ = $class->new( $pkg, $ver );
-        }
-        else {
-            $_ = $class->new($_);
-        }
-    }
-
-    return @list;
-}
-
-1;
-
 # List of Dep objects
 # Overrides the stringification operator so that one can use Dep::List
 # and a string, consisting of list of dependencies simultaneously
@@ -218,6 +101,8 @@
 
 package Dep::List;
 
+use Debian::Dependency;
+
 use overload
     '""'   => \&stringify;
 
@@ -227,7 +112,9 @@
     my $self = bless [], $class;
 
     if ( defined($val) ) {
-        @{$self} = map( Dep->new($_), split( /\s*,\s*/, $val ) );
+        @{$self} = map(
+            Debian::Dependency->new($_),
+            split( /\s*,\s*/, $val ) );
     }
 }
 
@@ -245,6 +132,7 @@
 use warnings;
 
 use Debian::AptContents;
+use Debian::Dependency;
 
 my ($min_perl_version, $debstdversion, $priority,  $section,
     @depends,          @bdepends,      @bdependsi, $maintainer,
@@ -256,7 +144,7 @@
 $debstdversion = '3.8.0';
 $priority      = 'optional';
 $section       = 'perl';
- at depends       = ( Dep->new( '${perl:Depends}' ) );
+ at depends       = ( Debian::Dependency->new( '${perl:Depends}' ) );
 
 # 5.6.0-12 is where arch-indep modules are moved in /usr/share/perl5
 # (according to dh_perl)
@@ -264,7 +152,7 @@
 # is replaced below by calling substitute_perl_dependency
 $min_perl_version = '5.6.0-12';
 
- at bdependsi = ( Dep->new( 'perl', $min_perl_version ) );
+ at bdependsi = ( Debian::Dependency->new( 'perl', $min_perl_version ) );
 $arch      = 'all';
 $date      = email_date(time);
 $startdir  = getcwd();
@@ -345,7 +233,7 @@
     'refresh-cache'   => \$opt_refresh_cache,
 ) or die usage_instructions();
 
- at bdepends = ( Dep->new( 'debhelper', $opt_dh ) );
+ at bdepends = ( Debian::Dependency->new( 'debhelper', $opt_dh ) );
 
 # Help requested? Nice, we can just die! Isn't it helpful?
 die usage_instructions() if $opt_help;
@@ -441,18 +329,18 @@
 
 undef($apt_contents) unless $apt_contents->cache;
 
-push @depends, Dep->new('${shlibs:Depends}') if $arch eq 'any';
-push @depends, Dep->new('${misc:Depends}');
+push @depends, Debian::Dependency->new('${shlibs:Depends}') if $arch eq 'any';
+push @depends, Debian::Dependency->new('${misc:Depends}');
 my $extradeps = extract_depends( $maindir, $apt_contents, 0 );
 push @depends, @$extradeps;
-push @depends, Dep->parse_list($opt_depends) if $opt_depends;
+push @depends, Debian::Dependency->parse_list($opt_depends) if $opt_depends;
 
 $module_build = ( -f "$maindir/Build.PL" ) ? "Module-Build" : "MakeMaker";
 extract_changelog($maindir);
 extract_docs($maindir);
 extract_examples($maindir);
 
-push @bdepends, Dep->new('libmodule-build-perl')
+push @bdepends, Debian::Dependency->new('libmodule-build-perl')
     if ( $module_build eq "Module-Build" );
 
 my ( @extrabdepends, @extrabdependsi );
@@ -469,10 +357,10 @@
     );
 }
 
-push @bdepends, Dep->parse_list($opt_bdepends) if $opt_bdepends;
+push @bdepends, Debian::Dependency->parse_list($opt_bdepends) if $opt_bdepends;
 push @bdepends, @extrabdepends;
 
-push @bdependsi, Dep->parse_list($opt_bdependsi) if $opt_bdependsi;
+push @bdependsi, Debian::Dependency->parse_list($opt_bdependsi) if $opt_bdependsi;
 push @bdependsi, @extrabdependsi;
 
 apply_overrides();
@@ -1105,7 +993,7 @@
 
     }
 
-    return map( Dep->new( $_, $deps{$_} ), sort( keys(%deps) ) );
+    return map( Debian::Dependency->new( $_, $deps{$_} ), sort( keys(%deps) ) );
 }
 
 sub find_debs_for_modules {
@@ -1164,10 +1052,10 @@
                     ) <= 0;
                 }
 
-                push @debs, Dep->new( $deb, $v );
+                push @debs, Debian::Dependency->new( $deb, $v );
             }
             else {
-                push @debs, Dep->new($deb);
+                push @debs, Debian::Dependency->new($deb);
             }
         }
         else {
@@ -1698,13 +1586,13 @@
     $priority = $val
         if (
         defined( $val = get_override_val( $data, $subkey, 'priority' ) ) );
-    @depends = Dep->parse_list($val)
+    @depends = Debian::Dependency->parse_list($val)
         if (
         defined( $val = get_override_val( $data, $subkey, 'depends' ) ) );
-    @bdepends = Dep->parse_list($val)
+    @bdepends = Debian::Dependency->parse_list($val)
         if (
         defined( $val = get_override_val( $data, $subkey, 'bdepends' ) ) );
-    @bdependsi = Dep->parse_list($val)
+    @bdependsi = Debian::Dependency->parse_list($val)
         if (
         defined( $val = get_override_val( $data, $subkey, 'bdependsi' ) ) );
     $desc = $val

Added: trunk/dh-make-perl/lib/Debian/Dependency.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/lib/Debian/Dependency.pm?rev=28044&op=file
==============================================================================
--- trunk/dh-make-perl/lib/Debian/Dependency.pm (added)
+++ trunk/dh-make-perl/lib/Debian/Dependency.pm Thu Dec 11 08:08:52 2008
@@ -1,0 +1,121 @@
+package Debian::Dependency;
+
+use strict;
+use warnings;
+
+# The C<Dep> class represent a dependency relationship in an opaque way
+#
+# SYNOPSIS
+#
+#   my $d = Dep->new( 'perl' );             # simple dependency
+#   my $d = Dep->new('perl (>= 5.10)');     # also parses a single argument
+#   my $d = Dep->new( 'perl', '5.10' );     # dependency with a version
+#   my $d = Dep->new( 'perl', '>=', '5.10' );
+#                               # dependency with version and relation
+#   print $d->pkg;  # 'perl'
+#   print $d->ver;  # '5.10
+#
+#                                   # for people who like to type much
+#   my $d = Dep->new( { pkg => 'perl', ver => '5.10' } );
+#
+#   # stringification
+#   print "$d"      # 'perl (>= 5.10)'
+#
+#   # parsing lists
+#   my @list = Dep->parse_list( 'perl (>= 5.10), libc (>= 2.7)' );
+#   print $list[0]->ver;    # '5.10'
+#
+#                                                       # <= relationship
+#   my @list = Dep->parse_list( 'perl (<= 5.11)' );     # UNSUPPORTED
+#
+
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw( pkg ver rel ));
+
+use overload
+    '""'    => \&stringify;
+sub new {
+    my $class = shift;
+    $class = ref($class) if ref($class);
+
+    return $class->SUPER::new(@_) if ref( $_[0] );
+
+    return $class->parse( $_[0] )
+        if @_ == 1;
+
+    return $class->SUPER::new( { pkg => $_[0], rel => '>=', ver => $_[1] } )
+        if @_ == 2;
+
+    return $class->SUPER::new( { pkg => $_[0], rel => $_[1], ver => $_[2] } )
+        if @_ == 3;
+
+    die "Unsupported number of arguments";
+}
+
+sub stringify {
+    my $self = shift;
+
+    return (
+        $self->ver
+        ? $self->pkg . ' (' . $self->rel . ' ' . $self->ver . ')'
+        : $self->pkg
+    );
+}
+
+sub parse {
+    my ( $class, $str ) = @_;
+
+    if ( $str =~ m{
+            ^               # start from the beginning
+            ([^\(\s]+)      # package name - no paren, no space
+            \s*             # oprional space
+            (?:             # version is optional
+                \(          # opening paren
+                    (       # various relations 
+                        <<
+                      | <=
+                      | ==
+                      | >=
+                      | >>
+                    )
+                    \s*     # optional space
+                    (.+)    # version
+                \)          # closing paren
+            )?
+            $}x             # done
+    )
+    {
+        return $class->new( {
+            pkg => $1,
+            ( ( defined($2) and defined($3) )
+               ? ( rel => $2, ver => $3 )
+               : ()
+            )
+        } );
+    }
+    else {
+        die "Unable to parse '$str'";
+    }
+}
+
+sub parse_list {
+    my $class = shift;
+    my @list = split( /\s*,\s*/, shift );
+
+    for( @list ) {
+        if ( /(^S+)\s(.+)$/ ) {
+            my ( $pkg, $ver ) = ( $1, $2 );
+            $ver =~ s/^>=\s*//
+                or die "$_: only '>=' relationships are supported";
+            $_ = $class->new( $pkg, $ver );
+        }
+        else {
+            $_ = $class->new($_);
+        }
+    }
+
+    return @list;
+}
+
+1;
+

Modified: trunk/dh-make-perl/t/Dep.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/t/Dep.t?rev=28044&op=diff
==============================================================================
--- trunk/dh-make-perl/t/Dep.t (original)
+++ trunk/dh-make-perl/t/Dep.t Thu Dec 11 08:08:52 2008
@@ -5,34 +5,35 @@
 
 use Test::More tests => 18;
 
-use FindBin qw($Bin);
+BEGIN {
+    use_ok('Debian::Dependency');
 
-require_ok "$Bin/../dh-make-perl";        # Load our code for testing.
+};
 
-my $plain = eval{ Dep->new('perl') };
+my $plain = eval{ Debian::Dependency->new('perl') };
 ok( !$@, 'simple Dep constructed' );
 is( $plain->pkg, 'perl', 'name parsed correctly' );
 is( $plain->rel, undef, "plain dependency has no relation" );
 is( $plain->ver, undef, "plain dependency has no version" );
 
-my $ver   = eval { Dep->new('libfoo', '5.6') };
+my $ver   = eval { Debian::Dependency->new('libfoo', '5.6') };
 ok( !$@, 'versioned Dep constructed' );
 is( $ver->pkg, 'libfoo', 'versioned name parsed' );
 is( $ver->ver, '5.6', 'oversion parsed' );
 is( $ver->rel, '>=', '>= relation parsed' );
 
-$ver = eval { Dep->new('libfoo (>= 5.6)') };
+$ver = eval { Debian::Dependency->new('libfoo (>= 5.6)') };
 ok( !$@, 'versioned Dep parsed' );
 is( $ver->pkg, 'libfoo', 'package of ver dep' );
 is( $ver->rel, '>=', 'relation of ver dep' );
 is( $ver->ver, '5.6', 'version of ver dep' );
 is( "$ver", 'libfoo (>= 5.6)', 'Versioned Dep stringified' );
 
-my $loe = eval { Dep->new('libbar (<= 1.2)') };
+my $loe = eval { Debian::Dependency->new('libbar (<= 1.2)') };
 ok( !$@, '<= dependency parsed' );
 is( $loe->rel, '<=', '<= dependency detected' );
 
-my $se = eval { Dep->new('libfoo-perl (==1.2)') };
+my $se = eval { Debian::Dependency->new('libfoo-perl (==1.2)') };
 ok( !$@, '== dependency parsed' );
 is( $se->rel, '==', '== dependency detected' );
 




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