package IPC::MMA;

use strict;
use warnings;
use Carp;
require Exporter;
require DynaLoader;
our @ISA = qw(Exporter DynaLoader);

# set the version for version checking
our $VERSION = 0.8;

# nothing is exported into callers namespace by default
our @EXPORT = qw( );

# exported by request
our %EXPORT_TAGS = (
basic => [qw(
    mm_maxsize         mm_create           mm_permission           mm_destroy
    mm_lock            mm_unlock           MM_LOCK_RD              MM_LOCK_RW
    mm_available       mm_error            mm_display_info         
    mm_alloc_size      mm_round_up )], # last 2 are ours
scalar => [qw(
    mm_make_scalar     mma_make_scalar     mm_free_scalar         mma_free_scalar
    mm_scalar_fetch    mma_scalar_fetch    mm_scalar_store        mma_scalar_store
    mm_scalar_get      mma_scalar_get      mm_scalar_set          mma_scalar_set )],
array => [qw(
    mm_make_array      mma_make_array      mm_array_status        mma_array_status
    mm_array_fetch     mma_array_fetch     mm_array_fetch_nowrap  mma_array_fetch_nowrap
    mm_array_store     mma_array_store     mm_array_store_nowrap  mma_array_store_nowrap
    mm_array_extend    mma_array_extend    mm_array_storesize     mma_array_storesize
    mm_array_exists    mma_array_exists    mm_array_exists_nowrap mma_array_exists_nowrap
    mm_array_splice    mma_array_splice    mm_array_splice_nowrap mma_array_splice_nowrap    
    mm_array_delete    mma_array_delete    mm_array_delete_nowrap mma_array_delete_nowrap
    mm_array_push      mma_array_push      mm_array_pop           mma_array_pop
    mm_array_shift     mma_array_shift     mm_array_unshift       mma_array_unshift
    mm_array_clear     mma_array_clear     mm_free_array          mma_free_array
    mm_array_fetchsize mma_array_fetchsize 
    MM_BOOL_ARRAY      MM_DOUBLE_ARRAY     MM_INT_ARRAY           MM_UINT_ARRAY
    MM_ARRAY           MM_FIXED_REC        MM_CSTRING )],
hash => [qw(
    mm_make_hash       mma_make_hash       mm_hash_fetch          mma_hash_fetch
    mm_hash_get        mma_hash_get        mm_hash_get_value      mma_hash_get_value
    mm_hash_get_entry  mma_hash_get_entry
    mm_hash_exists     mma_hash_exists     mm_hash_delete         mma_hash_delete
    mm_hash_store      mma_hash_store      mm_hash_insert         mma_hash_insert
    mm_hash_first_key  mma_hash_first_key  mm_hash_next_key       mma_hash_next_key
    mm_hash_scalar     mma_hash_scalar     mm_hash_clear          mma_hash_clear
    mm_free_hash       mma_free_hash       MM_MUST_CREATE         MM_NO_CREATE
    MM_NO_OVERWRITE )],
btree => [qw(
    mm_make_btree_table      mma_make_btree_table     
    mm_btree_table_insert    mma_btree_table_insert
    mm_btree_table_get       mma_btree_table_get      
    mm_btree_table_exists    mma_btree_table_exists
    mm_btree_table_delete    mma_btree_table_delete   
    mm_btree_table_first_key mma_btree_table_first_key
    mm_btree_table_next_key  mma_btree_table_next_key 
    mm_clear_btree_table     mma_clear_btree_table
    mm_free_btree_table      mma_free_btree_table 
    MM_MUST_CREATE           MM_NO_CREATE               MM_NO_OVERWRITE)] );

# make the ":all" class as the union of the others, eliminating duplicates)
{   my %seen;
    push @{$EXPORT_TAGS{all}}, 
        grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} for (keys %EXPORT_TAGS);
}
# callers can import any of those
our @EXPORT_OK = @{$EXPORT_TAGS{'all'}};

# AUTOLOAD is used to
#  1) 'autoload' constants from the constant() function in MMA.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 MMA.xs
    my $val = constant($constname, 0);
    if ($!) {

        # the name in $AUTOLOAD is not a constant defined by IPC::MMA
                     # sah = scalar/array/hash
        if (my ($mmx, $sah, $function) =
            $AUTOLOAD =~ /^IPC::(MMA?)::(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 "mm_${sah}Ptr") {
                    croak "3rd operand of tie should be the return value from "
                        . " mm_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|SHIFT|POP|PUSH|UNSHIFT|SPLICE|EXTEND|STORESIZE)$/
                  || $sah eq 'hash'
                  && $function =~ /^(NEXTKEY|SCALAR|FIRSTKEY)$/) {

                $function =~ s/KEY$/_KEY/;

                if ($sah eq 'array'                             # nowrap
                 && $function =~ /^(FETCH$|STORE$|EXI|D|SP)/) { # nowrap
                    $function .= '_nowrap';                     # nowrap
                }
                my $subname = lc($mmx) . "_${sah}_" . lc($function);
                ####temp
                # carp "$subname was called";

                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 MMA.xs
                    goto &$subname;
                };
                # having defined the symbol, execute the sub above 
                #   and then the one in MMA.xs
                goto &$AUTOLOAD;

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

# these exist only to serve as 'tie' methods: they cannot be use'd
# (this is a bit repetitive)
package IPC::MM::Scalar;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
1;
package IPC::MMA::Scalar;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
1;
package IPC::MM::Array;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
1;
package IPC::MMA::Array;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
1;
package IPC::MM::Hash;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
# have to declare SCALAR so perl will call our SCALAR -> mm_hash_scalar
sub SCALAR;
1;
package IPC::MMA::Hash;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
sub SCALAR;
1;
package IPC::MM::BTree;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
sub SCALAR;
1;
package IPC::MMA::BTree;
use strict;
use warnings;
our @ISA = qw(IPC::MMA);
sub SCALAR;
1;
