view release on metacpan or  search on metacpan

lib/Acme/Teddy.pm  view on Meta::CPAN

package Acme::Teddy;
# For we doeth darke magiks.
#use strict;
#use warnings;

#~ use Devel::Comments;

our $VERSION    = 1.002003;

#=========# EXTERNAL FUNCTION
#
#   use Acme::Teddy qw( your $user @symbols );  # calls import()
#       
# Purpose   : Exports all arguments to caller.
# Parms     : $pkg      : Provided by use()
#           : @imports  : Anything
# Writes    : Caller's symbol table.
# Throws    : When passed something bizzare, maybe.
# See also  : Exporter::Heavy::heavy_export()
# 
# Exports almost *anything* passed in. 
# Note that this module defines very little, 
#   so you need to define stuff to export it. 
#
sub import {
    my $pkg         = shift;
    my @imports     = @_;       # anything you like, baby
    my $callpkg     = caller(1);
    my $type        ;
    my $sym         ;
    
    ### $callpkg
    ### $pkg
    ### @imports
    
    # Ripped from Exporter::Heavy::heavy_export()
    foreach $sym (@imports) {
    # shortcut for the common case of no type character
    (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
        unless $sym =~ s/^(\W)//;
    $type = $1;
    *{"${callpkg}::$sym"} =
        $type eq '&' ? \&{"${pkg}::$sym"} :
        $type eq '$' ? \${"${pkg}::$sym"} :
        $type eq '@' ? \@{"${pkg}::$sym"} :
        $type eq '%' ? \%{"${pkg}::$sym"} :
        $type eq '*' ?  *{"${pkg}::$sym"} :
        die "$pkg: Can't export symbol: $type$sym\n", $!;
    }
}; ## import

# For we enter thee sonne.
use strict;
use warnings;

#=========# CLASS METHOD
#
#   my $bear    = Acme::Teddy->new();
#   my $bear    = Acme::Teddy->new({ -a  => 'x' });
#   my $bear    = Acme::Teddy->new([ 1, 2, 3, 4 ]);
#   my $bear    = Acme::Teddy->new( {}, @some_data );
#       
# Purpose   : Dummy constructor
# Parms     : $class    : Any subclass of this class
#           : $self     : Any reference
#           : @init     : All remaining args
# Returns   : $self
# Invokes   : init()
# 
# If invoked with $class only, 
#   blesses an empty hashref and calls init() with no args. 
# 
# If invoked with $class and a reference,
#   blesses the reference and calls init() with any remaining args. 
# 
sub new {
    my $class   = shift;
    my $self    = shift || {};      # default: hashref
    
    bless ($self => $class);
    $self->init(@_);
    
    return $self;
}; ## new

#=========# OBJECT METHOD
#
#   $obj->init(@_);     # initialize object