view release on metacpan or  search on metacpan

lib/NetServer/Portal/Pi.pm  view on Meta::CPAN

		    for (my $c=0; $c < $cols; $c++) {
			my $cel = $got[$l + $c*$per] || '';
			$cel .= ' 'x($maxlen - length $cel);
			$row .= $cel;
		    }
		    push @grid, $row;
		}
		@got = @grid;
	    }
	}
	$o->add_buffer(\@got);

    } elsif (@{$o->{Path}} and $in eq 'ls') {
	my @p = @{$o->{Path}};
	
	my $Dumper = new_dumper([ $p[$#p] ]);
	$Dumper->Maxdepth(1);
	$o->add_buffer([split /\n/,  $Dumper->Dump]);

    } elsif ($in =~ m,^cd (\s+/)? $,x) {
	@{$o->{Package}} = ();
	@{$o->{Path}} = ();
	
    } elsif ($in =~ s/^cd\s+//) {
	my @at = $o->resolve_path($in);
	return if (@at == 1 and !defined $at[0]);
	@{$o->{Package}} = ();
	while (@at and !ref $at[0]) {
	    push @{$o->{Package}}, shift(@at);
	}
	@{$o->{Path}} = @at;

    } else {
	$in .= "\n" if $in !~ /\n$/;
	my @warn;
	local $SIG{__WARN__} = sub {
	    push @warn, @_;
	};
	my $pack = join('::', @{$o->{Package}}) || 'main';
	my @eval = eval "no strict;\n#line 1 \"input\"\npackage $pack;\n$in";
	if ($@) {
	    $o->add_buffer([split /\n/, "package $pack;\n$in---\n$@"]);
	} else {
	    my $warns='';
	    $warns = join('', @warn)."---\n"
		if @warn;
	    my $Dumper = new_dumper(\@eval);
	    $o->add_buffer([split /\n/, "package $pack;\n$in---\n".$warns.
			    $Dumper->Dump]);
	}
    }
    pop @{$o->{O}} if @{$o->{O}} > 16;
}

sub resolve_path {
    my ($o, $path) = @_;
    my @at = (@{$o->{Package}}, @{$o->{Path}});
    @at=()
	if $path =~ s,^/,,;
    if ($path =~ m,^[\w\.\:/-]+$,) {
	my @step = split m'/+', $path;
	for my $step (@step) {
	    next if $step eq '.';
	    if ($step eq '..') {
		pop @at;
	    } else {
		if (@at and ref $at[$#at]) {
		    my $at = $at[$#at];
		    my $to;
		    if (reftype $at eq 'ARRAY') {
			$to = $at->[$step];
		    } elsif (reftype $at eq 'HASH') {
			$to = $at->[$step];
		    } else {
			$o->{error} = "Can't cd $step through '$at'.";
			return @at;
		    }
		    if (!ref $to) {
			$o->{error} = "Can't cd $step into '$to'.";
			return @at;
		    }
		    push @at, $to;
		} else {
		    $step =~ s/::$//;
		    push @at, $step;
		}
	    }
	}
	@at;
    } else {
	my $package = join('::', @{$o->{Package}}) || 'main';
	my @r = eval "no strict;\n#line 1 \"input\"\npackage $package;\n$path";
	if ($@) {
	    $o->{error} = $@;
	    return undef;
	}
	if (!@r) {
	    $o->{error} = "Nothing there.";
	} elsif (@r == 1) {
	    if (ref $r[0]) {
		return (@at, $r[0])
	    } else {
		$o->{error} = "Can't cd into '$r[0]'";
		return undef;
	    }
	} else {
	    return (@at, \@r);
	}
    }
}

1;