File Coverage

blib/lib/Inline/Wrapper.pm

Criterion	Covered	Total	%
statement	90	104	86.5
branch	15	36	41.6
condition	3	25	12.0
subroutine	26	28	92.8
pod	14	14	100.0
total	148	207	71.5

package Inline::Wrapper;
#
#   Inline::* module dynamic loader and useful wrapper routines
#
#   $Id: Wrapper.pm 14 2010-03-10 09:08:18Z infidel $
#
#   POD documentation after __END__
#

use strict;
use warnings;
use Carp qw( carp croak );
use Data::Dumper;
use vars qw( $TRUE $FALSE $VERSION );
BEGIN { $INC{'Inline::Wrapper.pm'} ||= __FILE__ };  # recursive use check
use Inline::Wrapper::Module;                        # individual code modules

###
### VARS
###

$VERSION = '0.05';
*TRUE    = \1;
*FALSE   = \0;

my $DEFAULTS = {
    base_dir    => '.',                 # default search directory
    auto_reload => $FALSE,              # automatically reload module?
    language    => 'Lua',               # default language
};

my $LANGS = {
    Foo         => '.foo',              # built in to Inline's distro
    C           => '.c',
    Lua         => '.lua',
#    'C++'       => '.cpp',
#    Java        => '.java',
#    Python      => '.py',
#    Tcl         => '.tcl',
#    Ruby        => '.rb',
};

my $PARAMS = {
    base_dir    => sub { $_[0] },
    auto_reload => sub { $_[0] ? $TRUE : $FALSE },
    language    => sub {
                     defined( $_[0] ) and exists( $LANGS->{$_[0]} )
                         ? $_[0]
                         : ( carp sprintf( "Invalid language: %s; using %s",
                                           $_[0], $DEFAULTS->{language} )
                               and $DEFAULTS->{language} )
                   },
};

###
### CONSTRUCTOR
###

sub new
{
    my( $class, @args ) = @_;

    # Check parameters
    @args = %{ $args[0] } if( ref( $args[0] ) eq 'HASH' );
    croak "$class: \%args must be a hash; read the docs" if( @args & 1 );

    # Set up object
    my $self = {
        %$DEFAULTS,
#        modules     => {},
    };
    bless( $self, $class );

    # Initialize object instance
    @args = $self->_process_args( @args );
    $self->initialize( @args );

    return( $self );
}

sub initialize
{
    my( $self ) = @_;

    $self->{modules} = {};

    return;
}

###
### PUBLIC METHODS
###

# Load a code module named $modname from $base_dir with $lang_extension
sub load
{
    my( $self, $modname, @args ) = @_;

    # Check arguments
    croak "load() \$modname is a required param; read the docs"
        unless( $modname );
    @args = %{ $args[0] } if( ref( $args[0] ) eq 'HASH' );
    croak "load(): \%args must be a hash; read the docs"
        if( @args & 1 );
    my %args = @args;

    # Check for duplicate modules, return @function list if found
    # XXX: Possible bug; should probably issue reload if auto_reload
    #   ends up being set to true.
    if( my $temp_module = $self->_module( $modname ) )
    {
        my $temp_lang     = $args{language} || $self->language();
        my $temp_base_dir = $args{base_dir} || $self->base_dir();
        if( $temp_lang     eq $temp_module->language() &&
            $temp_base_dir eq $temp_module->base_dir() )
        {
            $temp_module->set_auto_reload( $args{auto_reload} )
                if( $args{auto_reload} );
            print "HONK!\n";
            return( $temp_module->_function_list() );   # RETURN
        }
    }

    # Create a new module object
    my $module = Inline::Wrapper::Module->new(
            module_name     => $modname,
            lang_ext        => $self->_lang_ext(),
            $self->_settings(),
            %args,
    );
    $self->_add_module( $modname, $module );

    # Actually attempt to load the inline module
    my @functions = $module->_load();

    return( @functions );
}

# Completely unload a loaded $modname, rendering its functions uncallable
sub unload
{
    my( $self, $modname ) = @_;

    carp "$modname not loaded" and return
        unless( ref( $self->_module( $modname ) ) );

    return( $self->_del_module( $modname ) && $modname );
}

# Run a $modname::$funcname function, passing it @args
sub run
{
    my( $self, $modname, $funcname, @args ) = @_;

    my $module    = $self->_module( $modname );
    my @retvals   = $module->_run( $funcname, @args );

    return( @retvals );
}

# Return the list of already-loaded modules
sub modules
{
    my( $self ) = @_;

    return( $self->_module_names() );
}

# Return the list of functions loaded from $modname
sub functions
{
    my( $self, $modname ) = @_;

    my $module = $self->_module( $modname );
    carp "Module '$modname' not loaded"
        and return()
            unless( ref( $module ) );

    return( $module->_function_list() );
}

###
### PRIVATE METHODS
###

sub _process_args
{
    my( $self, @args ) = @_;
    croak "_process_args() requires an even number of params" if( @args & 1 );
    my %args = @args;

    for( keys %args )
    {
        next unless( exists( $PARAMS->{lc $_} ) );      # not for us, pass on
        $self->{lc $_} = $PARAMS->{lc $_}->( $args{$_} );
        delete( $args{$_} );
    }

    return( %args );
}

sub _module_names
{
    my( $self ) = @_;

    return( keys( %{ $self->{modules} } ) );
}

sub _settings
{
    my( $self ) = @_;

    my %defaults = map { $_ => $self->{$_} } keys( %$DEFAULTS );

    return( %defaults );
}

###
### ACCESSORS
###

sub base_dir
{
    my( $self ) = @_;

    return( $self->{base_dir} );
}

sub set_base_dir
{
    my( $self, $base_dir ) = @_;

    # Validate
    $base_dir = $PARAMS->{base_dir}->( $base_dir );

    return( defined( $base_dir )
              ? $self->{base_dir} = $base_dir
              : $self->{base_dir} );
}

sub language
{
    my( $self ) = @_;

    return( $self->{language} );
}

sub set_language
{
    my( $self, $language ) = @_;

    # Validate
    $language = $PARAMS->{language}->( $language );

    return( defined( $language )
              ? $self->{language} = $language
              : $self->{language} );
}

sub add_language
{
    my( $self, $language, $lang_ext ) = @_;

    carp "add_language(): Language not set; read the docs"
        and return
            unless( $language );
    carp "add_language(): Language extension not set; read the docs"
        and return
            unless( $lang_ext );

    return( ( $LANGS->{$language} = $lang_ext ) ? $language : undef );
}

sub auto_reload
{
    my( $self ) = @_;

    return( $self->{auto_reload} );
}

sub set_auto_reload
{
    my( $self, $auto_reload ) = @_;

    # Validate
    $auto_reload = $PARAMS->{auto_reload}->( $auto_reload );

    return( defined( $auto_reload )
              ? $self->{auto_reload} = $auto_reload
              : $self->{auto_reload} );
}

### PRIVATE ACCESSORS

sub _module
{
    my( $self, $modname ) = @_;

    return( $self->{modules}->{$modname} );
}

sub _add_module
{
    my( $self, $modname, $module ) = @_;

    return( $self->{modules}->{$modname} = $module );
}

sub _del_module
{
    my( $self, $modname ) = @_;

    # Namespace is deleted by $module->DESTROY()
    return( delete( $self->{modules}->{$modname} ) );
}

###
### PRIVATE UTILITY ROUTINES
###

sub _lang_ext
{
    my( $self, $language ) = @_;

    $language ||= $self->{language};

    return( $LANGS->{$language} );
}

1;

__END__