[dh-make-perl] 01/02: Control: revert ->binary to plain hashref and provide the Tie::IxHash tie via ->binary_tie

Damyan Ivanov dmn at alioth.debian.org
Thu Aug 8 13:08:41 UTC 2013


This is an automated email from the git hooks/post-receive script.

dmn pushed a commit to branch master
in repository dh-make-perl.

commit ec883d9ef30924e9bad0334171fb0e4a230f3c22
Author: Damyan Ivanov <dmn at debian.org>
Date:   Thu Aug 8 15:04:40 2013 +0200

    Control: revert ->binary to plain hashref and provide the Tie::IxHash tie via ->binary_tie
    
    Thanks to Olof Johansson. Closes: #712432
---
 lib/Debian/Control.pm               |   24 +++++++++++++++---------
 lib/Debian/Control/FromCPAN.pm      |    4 ++--
 lib/DhMakePerl/Command/Packaging.pm |   18 +++++++++---------
 lib/DhMakePerl/Command/make.pm      |    4 ++--
 t/Control.t                         |    8 ++++----
 5 files changed, 32 insertions(+), 26 deletions(-)

diff --git a/lib/Debian/Control.pm b/lib/Debian/Control.pm
index 6acd164..30f9d0d 100644
--- a/lib/Debian/Control.pm
+++ b/lib/Debian/Control.pm
@@ -33,11 +33,15 @@ stanza of the Debian source package control file.
 
 =item binary
 
-A hash reference (actually L<Tie::IxHash> instance) with keys being binary
+A hash reference with keys being binary
 package names and values instances of L<Debian::Control::Stanza::Binary> class.
 Contains the information of the binary package stanzas of Debian source package
 control file.
 
+=item binary_tie
+
+A L<Tie::IxHash> object tied to the B<binary> hash.
+
 =back
 
 =cut
@@ -47,7 +51,7 @@ package Debian::Control;
 use base 'Class::Accessor';
 use strict;
 
-__PACKAGE__->mk_accessors(qw( source binary _parser ));
+__PACKAGE__->mk_accessors(qw( source binary binary_tie _parser ));
 
 use Parse::DebControl;
 use Debian::Control::Stanza::Source;
@@ -76,7 +80,9 @@ sub new {
 
     $self->_parser( Parse::DebControl->new );
 
-    $self->binary( Tie::IxHash->new );
+    my %b;
+    $self->binary_tie( tie %b, 'Tie::IxHash' );
+    $self->binary( \%b );
     $self->source( Debian::Control::Stanza::Source->new );
 
     return $self;
@@ -113,7 +119,7 @@ sub read {
             $self->source( Debian::Control::Stanza::Source->new($_) );
         }
         elsif ( $_->{Package} ) {
-            $self->binary->Push(
+            $self->binary_tie->Push(
                 $_->{Package} => Debian::Control::Stanza::Binary->new($_) );
         }
         else {
@@ -137,23 +143,23 @@ All dependency lists are sorted before writing.
 sub write {
     my ( $self, $file ) = @_;
 
-    for my $s ( $self->source, $self->binary->Values ) {
+    for my $s ( $self->source, $self->binary_tie->Values ) {
         for ( $s->fields ) {
             $s->$_->sort if $s->is_dependency_list($_);
         }
     }
 
     if ( ref($file) and ref($file) eq 'SCALAR' ) {
-        $$file = join( "\n", $self->source, $self->binary->Values );
+        $$file = join( "\n", $self->source, $self->binary_tie->Values );
     }
     elsif ( ref($file) and ref($file) eq 'GLOB' ) {
-        $file->print( join( "\n", $self->source, $self->binary->Values ) );
+        $file->print( join( "\n", $self->source, $self->binary_tie->Values ) );
     }
     else {
         my $fh;
         open $fh, '>', $file or die "Unable to open '$file' for writing: $!";
 
-        print $fh join( "\n", $self->source, $self->binary->Values );
+        print $fh join( "\n", $self->source, $self->binary_tie->Values );
     }
 }
 
@@ -173,7 +179,7 @@ package stanzas present or the first has no C<Archiitecture> field.
 sub is_arch_dep {
     my $self = shift;
 
-    my $bin = $self->binary->Values(0);
+    my $bin = $self->binary_tie->Values(0);
 
     return undef unless $bin;
 
diff --git a/lib/Debian/Control/FromCPAN.pm b/lib/Debian/Control/FromCPAN.pm
index b623898..4135289 100644
--- a/lib/Debian/Control/FromCPAN.pm
+++ b/lib/Debian/Control/FromCPAN.pm
@@ -91,7 +91,7 @@ sub discover_dependencies {
         if %$opts;
 
     my $src = $self->source;
-    my $bin = $self->binary->Values(0);
+    my $bin = $self->binary_tie->Values(0);
 
     local @INC = ( $dir, @INC );
 
@@ -468,7 +468,7 @@ sub prune_perl_deps {
 
     # remove depending on ancient perl versions
     for my $perl ( qw( perl perl-base perl-modules ) ) {
-        for my $pkg ( $self->binary->Values ) {
+        for my $pkg ( $self->binary_tie->Values ) {
             for my $rel ( qw(Depends Recommends Suggests) ) {
                 my @ess = $pkg->$rel->remove($perl);
                 for my $dep (@ess) {
diff --git a/lib/DhMakePerl/Command/Packaging.pm b/lib/DhMakePerl/Command/Packaging.pm
index 12cff25..df803ac 100644
--- a/lib/DhMakePerl/Command/Packaging.pm
+++ b/lib/DhMakePerl/Command/Packaging.pm
@@ -212,9 +212,9 @@ sub set_package_name {
     $self->control->source->Source($pkgname)
         unless $self->control->source->Source;
 
-    $self->control->binary->Push( $pkgname =>
+    $self->control->binary_tie->Push( $pkgname =>
             Debian::Control::Stanza::Binary->new( { Package => $pkgname } ) )
-        unless $self->control->binary->FETCH($pkgname);
+        unless $self->control->binary->{$pkgname};
 }
 
 sub pkgname {
@@ -222,7 +222,7 @@ sub pkgname {
 
     my $self = shift;
 
-    my $pkg = $self->control->binary->Values(0)->Package;
+    my $pkg = $self->control->binary_tie->Values(0)->Package;
 
     defined($pkg) and $pkg ne ''
         or confess "called before set_package_name()";
@@ -260,7 +260,7 @@ sub extract_basic {
     $self->extract_name_ver();
 
     my $src = $self->control->source;
-    my $bin = $self->control->binary->Values(0);
+    my $bin = $self->control->binary_tie->Values(0);
 
     $src->Section('perl') unless defined $src->Section;
     $src->Priority('optional') unless defined $src->Priority;
@@ -659,7 +659,7 @@ sub extract_name_ver_from_makefile {
 sub extract_desc {
     my ( $self, $file ) = @_;
 
-    my $bin = $self->control->binary->Values(0);
+    my $bin = $self->control->binary_tie->Values(0);
     my $desc = $bin->short_description;
 
     $desc and return;
@@ -743,7 +743,7 @@ sub check_for_xs {
     ( !$self->cfg->exclude or $rel_path !~ $self->cfg->exclude )
         && /\.(xs|c|cpp|cxx)$/i
         && do {
-        $self->control->binary->Values(0)->Architecture('any');
+        $self->control->binary_tie->Values(0)->Architecture('any');
         };
 }
 
@@ -1468,7 +1468,7 @@ sub discover_utility_deps {
     $debhelper_version = '9.20120312' if $debhelper_version eq '9';
     $deps->add( Debian::Dependency->new( 'debhelper', $debhelper_version ) );
 
-    if ( $control->binary->Values(0)->Architecture eq 'all' ) {
+    if ( $control->binary_tie->Values(0)->Architecture eq 'all' ) {
         $control->source->Build_Depends_Indep->add('perl');
     }
     else {
@@ -1545,9 +1545,9 @@ sub discover_utility_deps {
     }
 
     # some mandatory dependencies
-    my $bin_deps = $control->binary->Values(0)->Depends;
+    my $bin_deps = $control->binary_tie->Values(0)->Depends;
     $bin_deps += '${shlibs:Depends}'
-        if $self->control->binary->Values(0)->Architecture eq 'any';
+        if $self->control->binary_tie->Values(0)->Architecture eq 'any';
     $bin_deps += '${misc:Depends}, ${perl:Depends}';
 }
 
diff --git a/lib/DhMakePerl/Command/make.pm b/lib/DhMakePerl/Command/make.pm
index 51d6032..cbe22b6 100644
--- a/lib/DhMakePerl/Command/make.pm
+++ b/lib/DhMakePerl/Command/make.pm
@@ -91,7 +91,7 @@ sub execute {
 
     $self->fill_maintainer;
 
-    my $bin = $self->control->binary->Values(0);
+    my $bin = $self->control->binary_tie->Values(0);
     $bin->short_description( $self->cfg->desc )
         if $self->cfg->desc;
 
@@ -374,7 +374,7 @@ sub install_package {
 
     my ( $archspec, $debname );
 
-    my $arch = $self->control->binary->Values(0)->Architecture;
+    my $arch = $self->control->binary_tie->Values(0)->Architecture;
 
     if ( !defined $arch || $arch eq 'any' ) {
         $archspec = `dpkg --print-architecture`;
diff --git a/t/Control.t b/t/Control.t
index c1974c3..eab09da 100644
--- a/t/Control.t
+++ b/t/Control.t
@@ -76,16 +76,16 @@ eq_or_diff( $written, $control, 'Control writes what it have read' );
 
 use_ok('Debian::Control::FromCPAN');
 bless $c, 'Debian::Control::FromCPAN';
-$c->binary->FETCH('libtest-compile-perl')->Depends->add('perl-modules');
+$c->binary->{'libtest-compile-perl'}->Depends->add('perl-modules');
 $c->prune_perl_deps;
-is( $c->binary->FETCH('libtest-compile-perl')->Depends . '',
+is( $c->binary->{'libtest-compile-perl'}->Depends . '',
     '${misc:Depends}, ${perl:Depends}, libuniversal-require-perl'
 );
 
 # test pruning dependency on perl version found in oldstable
-$c->binary->FETCH('libtest-compile-perl')->Depends->add('perl (>= 5.8.8)');
+$c->binary->{'libtest-compile-perl'}->Depends->add('perl (>= 5.8.8)');
 $c->prune_perl_deps;
-is( $c->binary->FETCH('libtest-compile-perl')->Depends . '',
+is( $c->binary->{'libtest-compile-perl'}->Depends . '',
     '${misc:Depends}, ${perl:Depends}, libuniversal-require-perl'
 );
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/dh-make-perl.git



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