Re: CPANPLUS working again on VMS Re: [PATCH@32279] Upgrade File::Fetch to 0.13_04...

[p5sagit/p5-mst-13.2.git] / lib / CPANPLUS / Module.pm

diff --git a/lib/CPANPLUS/Module.pm b/lib/CPANPLUS/Module.pm
index 96030d3..fb6be9b 100644 (file)
--- a/lib/CPANPLUS/Module.pm
+++ b/lib/CPANPLUS/Module.pm
@@ -66,7 +66,7 @@ my $tmpl = {
                                                         # 'bar-baz-1.03.tgz'
     description => { default => '' },                   # description of the
                                                         # module
-    dslip       => { default => '    ' },               # dslip information
+    dslip       => { default => EMPTY_DSLIP },          # dslip information
     _id         => { required => 1 },                   # id of the Internals
                                                         # parent object
     _status     => { no_override => 1 },                # stores status object
@@ -75,15 +75,28 @@ my $tmpl = {
     mtime       => { default => '' },
 };
 
-### autogenerate accessors ###
-for my $key ( keys %$tmpl ) {
-    no strict 'refs';
-    *{__PACKAGE__."::$key"} = sub {
-        $_[0]->{$key} = $_[1] if @_ > 1;
-        return $_[0]->{$key};
+### some of these will be resolved by wrapper functions that
+### do Clever Things to find the actual value, so don't create
+### an autogenerated sub for that just here, take an alternate
+### name to allow for a wrapper
+{   my %rename = (
+        dslip   => '_dslip'
+    );
+
+    ### autogenerate accessors ###
+    for my $key ( keys %$tmpl ) {
+        no strict 'refs';
+      
+        my $sub = $rename{$key} || $key;
+      
+        *{__PACKAGE__."::$sub"} = sub {
+            $_[0]->{$key} = $_[1] if @_ > 1;
+            return $_[0]->{$key};
+        }
     }
 }
 
+
 =pod
 
 =head1 CLASS METHODS
@@ -136,6 +149,27 @@ Description of the module -- only registered modules have this.
 The five character dslip string, that represents meta-data of the
 module -- again, only registered modules have this.
 
+=cut
+
+sub dslip {
+    my $self    = shift;   
+
+    ### if this module has relevant dslip info, return it
+    return $self->_dslip if $self->_dslip ne EMPTY_DSLIP;
+
+    ### if not, look at other modules in the same package,
+    ### see if *they* have any dslip info
+    for my $mod ( $self->contains ) {
+        return $mod->_dslip if $mod->_dslip ne EMPTY_DSLIP;
+    }
+    
+    ### ok, really no dslip info found, return the default
+    return EMPTY_DSLIP;
+}
+
+
+=pod
+
 =item status
 
 The C<CPANPLUS::Module::Status> object associated with this object.
@@ -1172,7 +1206,7 @@ sub contains {
     my $self = shift;
     my $cb   = $self->parent;
     my $pkg  = $self->package;
-    
+
     my @mods = $cb->search( type => 'package', allow => [qr/^$pkg$/] );
     
     return @mods;