Re: Autoloading tie routines

[cmac]

For cloture of this thread (not to be confused with "foreclosure" [a popular topic these days] nor with "closure" in perl and other languages [consult tilly about this]), here is the AUTOLOAD routine I ended up with:

# AUTOLOAD is used to
#  1) 'autoload' constants from the constant() function in ABC.xs
# If the name is not a constant then it's parsed for
#  2) a tie package-name::function-name, which if matched is executed

our $AUTOLOAD;  # implicit argument of AUTOLOAD

sub AUTOLOAD {

    # make the base name (without the "package::")
    (my $constname = $AUTOLOAD) =~ s/.*:://;
    # call the constant lookup routine in ABC.xs
    my $val = constant($constname, 0);
    if ($!) {

        # the name in $AUTOLOAD is not a constant defined by XYZ::ABC
                     # sah = scalar/array/hash
        if (my ($abcx, $sah, $function) =
            $AUTOLOAD =~ /^XYZ::(ABCA?)::(Scalar|Array|Hash|BTree)::([
+A-Z]+)$/) {

            if (($sah = lc $sah) eq 'btree') {$sah = 'hash'}
 
            if ($function eq uc("TIE$sah")) {
                my $self = shift;
                my $base_sah = shift; # sah = scalar/array/hash
                $val = '';
                if (!$base_sah || ($val = ref($base_sah)) ne "abc_${sa
+h}Ptr") {
                    croak "3rd operand of tie should be the return val
+ue from abc_make_$sah: ref was '$val'";
                }
                return bless \$base_sah, $self;

                                   # Scalar or Array or Hash
            } elsif ($function eq 'FETCH'
                  || $function eq 'STORE'
                  || $sah ne 'scalar' # Array or Hash
                  && $function =~ /^(DELETE|EXISTS|CLEAR)$/
                  || $sah eq 'array'
                  && $function =~ /^(FETCHSIZE|STORESIZE|EXTEND|POP|PU
+SH|SHIFT|UNSHIFT|SPLICE)$/
                  || $sah eq 'hash'
                  && $function =~ /^(FIRSTKEY|NEXTKEY|SCALAR)$/) {

                $function =~ s/KEY$/_KEY/;
  
                if ($sah eq 'array'                            #nowrap
                 && $function =~ /^(FETCH$|STORE$|EXI|D|SP)/) {#nowrap
                    $function .= '_nowrap';                    #nowrap
                }
                my $subname = lc($abcx) . "_${sah}_" . lc($function);
                no strict 'refs';
                
                # define the symbol so AUTOLOAD won't be called again 
+for this name
                *$AUTOLOAD = sub {
                    # dereference the base scalar/array/hash
                    my $base_sah_ref = shift;
                    unshift @_, $$base_sah_ref;
                    # go to the constructed sub name in ABC.xs
                    goto &$subname;
                };
                # having defined the symbol, execute the sub in ABC.xs
                goto &$AUTOLOAD;

            } elsif ($function eq 'UNTIE'
                  || $function eq 'DESTROY') {
                return;  # do nothing
        }   }
        croak "$AUTOLOAD is not a defined constant or subroutine for X
+YZ::ABC";
    }
    # the name in $AUTOLOAD is a constant defined by XYZ::ABC: define 
+it for perl
    no strict 'refs';
    # define the symbol so AUTOLOAD won't be called again for this nam
+e
    *$AUTOLOAD = sub{$val};
    # in the general case the following line should be goto &$AUTOLOAD
+;
    return $val;
}

If it changes I'll update this posting...

Thanks to all esp. tilly,
cmac
www.animalhead.com

A "universal can" is one that anyone can kick, drink from, or urinate into, although certain interactions among these methods are to be avoided...