view release on metacpan or  search on metacpan

lib/JSPL/Controller.pm  view on Meta::CPAN

use overload '%{}' => sub { tie my(%h),__PACKAGE__,$_[0]; \%h },
    fallback => 1;
sub TIEHASH { $_[1] }
sub DESTROY {} # This hasn't a passport
sub VALID { ${$_[0]}->[1] && ${$_[0]}->[1]->_isjsvis(${$_[0]}->[6]); }

package 
    JSPL::Any; #Hide from PAUSE

require Scalar::Util;
sub toSource {
    my $v = shift;
    my $rt = ref($v) || '';
    my $t;
    $t = tied(($rt eq 'ARRAY') ? @$v : ($rt eq 'HASH') ? %$v : $rt) if $rt;
    my $val;
    if($t && $t->isa('JSPL::Object') || 
       Scalar::Util::blessed($v) && $v->isa('JSPL::Object') && ($t=$v)
    ) {
	$val = $t->toSource();
    } elsif($rt) {
	for($rt) {
	    /^HASH$/ || /^JSPL::PerlHash$/ and do {
		$val = JSPL::PerlHash::toSource($v); last
	    };
	    /^ARRAY$/ || /^JSPL::PerlArray$/ and do {
		$val = JSPL::PerlArray::toSource($v); last
	    };
	    /^CODE$/ and do { $val = JSPL::PerlSub::toSource($v); last };
	    $val = $rt;
	}
    } elsif(Scalar::Util::looks_like_number($v)) {
	$val = "$v";
    } else {
	$val = "'$v'";
    }
    $val;
}

package
    JSPL::PerlScalar; # Hide from PAUSE

my $scalar;
our $prototype = \$scalar;

sub toString {
    my $this = shift || $JSPL::This;
    "${$this}";
}

package
    JSPL::PerlSub; # Hide from PAUSE

sub _const_sub { # Method call
    my $code = $_[1];
    my $frame = $] > 5.009 ? 1 : 2;
    JSPL::Context->check_privileges;
    my($package, $file, $line, $hints, $bitmask) = (caller $frame)[0,1,2,8,9];
    # warn sprintf("SBB: $package,$file,$line,'$code', H: %x, BM: %s\n", $hints,$bitmask);
    my $cr = eval join("\n",
	qq|package $package;BEGIN {\$^H=$hints;\${^WARNING_BITS}="$bitmask";}|,
	"#line $line $file",
	"sub {$code}") or Carp::croak("Can't compile: $@");
    return $cr;
}

sub prototype {}
our $wantarray = 1;

sub toString {
    my $code = shift || $JSPL::This;
    "sub {\n     [perl code]\n}";
}

sub toSource {
    my $code = shift || $JSPL::This;
    require B::Deparse;
    return 'sub ' . B::Deparse->new()->coderef2text($code)
}

sub call {
    my $code = $JSPL::This;
    local $JSPL::This = $_[0];
    shift unless(Scalar::Util::blessed($_[0]));
    $code->(@_);
}

sub apply {
    my $this = shift;
    my $arg = shift;
    if(ref($arg) eq 'HASH') { # Hack arround 'arguments' being an Object
	$arg = tied(%$arg);
	my @arg = map JSPL::Array::FETCH($arg, $_), 0 .. $arg->{'length'}-1;
	$arg = \@arg;
    }
    my $code = $JSPL::This;
    local $JSPL::This = $this;
    Scalar::Util::blessed($this) ? $code->($this, @{$arg} ) : $code->(@{$arg});
}

package
    JSPL::PerlArray; # Hide from PAUSE
# Some of the following methods are contrived for legacy support,
# will be simplified in 2.1
sub toString {
    my $aref = $JSPL::This;
    local $" = ',';
    no warnings 'uninitialized';
    return ref($aref) eq __PACKAGE__ ? "@{$$aref}" : "@{$aref}";
}

sub reverse {
    my $aref = $JSPL::This;
    my $legacy = ref($aref) eq __PACKAGE__;
    my @new = reverse $legacy ? @{$$aref} : @{$aref};
    ($legacy ? ${$aref} : $aref)->[$_] = $new[$_] for(0 .. $#new);
    $aref;
}

sub sort {
    my $aref = $JSPL::This;