Mostly as a test of Perl's namespace munging, I wanted to share
functions
and symbols ($var etc) between modules.

I came up with the following implemetation.

In a.pl you can say
---------
use b;
use shared qw( $config =&hello );

sub hello
{
        print "Hello World\n";
}
---------
and in 'b.pm' you can say
---------
use shared qw( $config &hello );
---------

Now, '$config' imports '$shared::config' into the local namespace
so all code and any modules which declares 'use shared qw($config)' can
use $config as a package local variable and see the same data.

AND.

use shared qw( =&hello )

saves 'package::hello' in a hash in 'shared::export_map'.  Later
when a module calls

use shared qw( &hello )

it exports filter::hello to the local package.  The first time 
'hello' is called, the filter::autoload uses the 'export_map' to export
'hello' to the calling package and then uses goto to make sure the
function
gets called. (package::hello can't be exported directly, because it gets
imported in 'b' before it gets exported from 'main' due to the order of
execution of use/import() )

It works well, but the obvious question is, has it been done already?

Cheers.
David


[bits/ideas stolen from Exporter::Heavy.pm]

----------------------- snip --------------------------
 
package shared;
 
require 5.001;
 
use strict;
use warnings;
 
use Exporter;
use Carp;
 
use vars qw( @ISA @EXPORTS $AUTOLOAD %export_map );
 
@ISA = qw( Exporter );
 
sub AUTOLOAD{
        no strict 'refs';
 
        # Perform a lookup for an exported function.  If found
        # export it to the calling namespace and go to it, otherwise
        # croak.
 
        if( exists $export_map{$AUTOLOAD} ) {
                my $pkg = caller;
                my $i = $export_map{$AUTOLOAD};
                *{"$pkg::$i->[1]"} = \&{$export_map{$AUTOLOAD}->[2]};
                goto &{$export_map{$AUTOLOAD}->[2]}
        }
        Carp::croak "Undefined subroutine &".$AUTOLOAD;
}
 
sub import {
    my @exports = @_[ 1 .. $#_ ];
 
    my ( $type, $sym, $ssym );
    my $pkg = caller;
 
    no strict 'refs';
    for $sym (@exports) {
 
        # Handle shared export.  (function local to a package and shared
out,
        # rather than shared import from 'shared::' namespace)

 
        if( $sym =~ /^=(\W)?(.+)$/ ) {
                Carp::croak "Symbol already shared from
$export_map{$2}->[2]"
                        if exists $export_map{$2};
                $export_map{$2} = [ $1, $2, "${pkg}::${2}" ];
                $export_map{"shared::$2"} = [ $1, $2, "${pkg}::${2}" ];
                next;
        }

        # Install symbol in 'pkg' to refer to symbol in 'shared::'
namespace
        # This will fail for functions, resulting in a call to
'AUTOLOAD' above.

        $ssym = "shared::${2}" if $sym =~ /^(\W)?(.+)$/;

        ( *{"${pkg}::$sym"} = \&{"$sym"}, next )
          unless $sym =~ s/^(\W)//;

        $type = $1;

        *{"${pkg}::$sym"} =
            $type eq '&' ? \&{"$ssym"}
          : $type eq '$' ? \${"$ssym"}
          : $type eq '@' ? [EMAIL PROTECTED]"$ssym"}
          : $type eq '%' ? \%{"$ssym"}
          : $type eq '*' ? *{"$ssym"}
          : undef;
    }
}

1;

----------------------- snip --------------------------
 
 

Regards,

David le Blanc

--              
Senior Technical Specialist      <http://www.identity-solutions.com.au/>

I d e n t i t y   S o l u t i o n s     
        
Level 1, 369 Camberwell Road, Melbourne, Vic 3124       
Ph 03 9813 1388 Fax 03 9813 1688 Mobile 0417 595 550
Email [EMAIL PROTECTED]
<mailto:[EMAIL PROTECTED]>      

The information transmitted is intended only for the recipient(s) to
which it is addressed and may contain confidential and/or privileged
material. Any review, retransmission, dissemination or other use of, or
taking of any action in reliance upon, this information by persons or
entities other than the intended recipient is prohibited. If you have
received this in error, please contact the sender and then delete it.
Identity Solutions has taken precautions to minimise the risk of
transmitting software viruses, but we advise you to carry out your own
virus checks on any attachment to this message. Identity Solutions
cannot accept liability for any loss or damage caused by software
viruses.



--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>


Reply via email to