/[cvs]/nfo/perl/libs/Data/Mungle/Code/Symbol.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Mungle/Code/Symbol.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by root, Wed Jan 22 17:59:22 2003 UTC revision 1.4 by joko, Fri Jun 6 03:25:42 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.4  2003/06/06 03:25:42  joko
6    ##  + sub alias_simple
7    ##
8    ##  Revision 1.3  2003/05/13 07:33:38  joko
9    ##  enhanced: now can get symbols as list or hash
10    ##
11    ##  Revision 1.2  2003/03/27 15:17:03  joko
12    ##  namespace fixes for Data::Mungle::*
13    ##
14  ##  Revision 1.1  2003/01/22 17:59:22  root  ##  Revision 1.1  2003/01/22 17:59:22  root
15  ##  + refactored from Mail::Audit::Dispatch  ##  + refactored from Mail::Audit::Dispatch
16  ##  ##
17  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
18    
19    
20  package Data::Code::Symbol;  =pod
21    
22    =head1 TODO
23    
24      o Investigate: Could this functionality be completely replaced through CPAN's
25         - Symbol.pm?
26         - Alias.pm?
27      
28    
29    =cut
30    
31    
32    package Data::Mungle::Code::Symbol;
33    
34  use strict;  use strict;
35  use warnings;  use warnings;
# Line 17  require Exporter; Line 38  require Exporter;
38  our @ISA = qw( Exporter );  our @ISA = qw( Exporter );
39  our @EXPORT_OK = qw(  our @EXPORT_OK = qw(
40    export_symbols    export_symbols
41      alias_simple
42  );  );
43    
44    
45  use Data::Code::Ref qw( get_coderef );  use Data::Mungle::Code::Ref qw( get_coderef );
46    use Symbol;
47    
48  sub export_symbols {  sub export_symbols {
49    my $symbols = shift;    my $symbols = shift;
50    my $mixinPackage = shift;    my $mixinPackage = shift;
51    my $callPackage = shift;    my $callPackage = shift;
52    $callPackage  ||= __PACKAGE__;    $callPackage  ||= __PACKAGE__;
53    foreach (@$symbols) {    if (ref $symbols eq 'ARRAY') {
54      {      foreach (@$symbols) {
55        no strict 'refs';        {
56        my $newName = $mixinPackage . '::' . $_;          no strict 'refs';
57        *{$newName} = get_coderef($callPackage, $_);          my $newName = $mixinPackage . '::' . $_;
58            *{$newName} = get_coderef($callPackage, $_);
59          }
60        }
61    
62      } elsif (ref $symbols eq 'HASH') {
63        foreach (keys %$symbols) {
64          {
65            no strict 'refs';
66            my $newName = $mixinPackage . '::' . $symbols->{$_};
67            *{$newName} = get_coderef($callPackage, $_);
68          }
69      }      }
70        
71      }
72    }
73    
74    # Qualifies a variable identified by package name and variable
75    # name into a valid symbol, resolves that symbol and stores the
76    # result (a reference to this variable) into the designated target (slot).
77    sub alias_simple {
78      my $rule = shift;
79      my $target = $rule->{slot};
80      my $name = $rule->{alias};
81      my $sym = qualify($rule->{var_name}, $rule->{var_pkg});
82      {
83        no strict 'refs';
84        $target->{$name} = ${$sym};
85    }    }
86  }  }
87    
88  1;  1;
89    __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed