File Coverage

blib/lib/Inline/Basic.pm

Criterion	Covered	Total	%
statement	29	53	54.7
branch	2	10	20.0
condition			n/a
subroutine	9	13	69.2
pod	1	5	20.0
total	41	81	50.6

package Inline::Basic;

use strict;
use vars qw($VERSION);
$VERSION = '0.01';

use base qw(Inline);

use IO::Scalar;
use Language::Basic;

sub _croak { require Carp; Carp::croak(@_) }

sub register {
    return {
	language => 'Basic',
	aliases  => [ qw(basic) ],
	type     => 'interpreted',
	suffix   => 'pl',
    };
}

sub validate { }

sub build {
    my $self = shift;
    my $prog = Language::Basic::Program->new;
    my $code = $self->{API}->{code};
    for my $line (split /\n/, $code) {
	$prog->line($line);
    }
    my $path = "$self->{API}->{install_lib}/auto/$self->{API}->{modpname}";
    $self->mkpath($path) unless -d $path;

    # Catching code to $script
    tie *STDOUT, 'IO::Scalar', \my $script;
    $prog->output_perl;
    untie *STDOUT;

    # Pre-format it
    $script =~ s/^.*# Subroutine Definitions\n#\n//s;
    $script =~ s/sub (\w+)_fun/"sub FN" . uc($1)/eg;

    {
	package Inline::Basic::Tester;
	eval $script;
    }
    _croak "Basic build failed: $@" if $@;

    my $obj = $self->{API}->{location};
    open BASIC_OBJ, "> $obj" or _croak "$obj: $!";
    print BASIC_OBJ $script;
    close BASIC_OBJ;
}

sub load {
    my $self = shift;
    my $obj = $self->{API}->{location};

    open BASIC_OBJ, "< $obj" or _croak "$obj: $!";
    my $code = do { local $/;  };
    close BASIC_OBJ;

    eval "package $self->{API}->{pkg};\n$code";
    _croak "Can't load Basic module $obj: $@" if $@;
}

sub info { }


1;
__END__