view release on metacpan or  search on metacpan

rs.pm  view on Meta::CPAN

					for (@f) {
						my ($from, $to) = flatten;
						$from =~ s/^([$@%&*])//;
						$to ||= $from;
						if (my $s = $1) {
							state $sigil = {'$' => 'SCALAR',
									'@' => 'ARRAY',
									'%' => 'HASH',
									'&' => 'CODE',
									'*' => 'GLOB'};
							_require $p;
							*{$ns . $to} = *{"${p}::$from"}{$sigil->{$s}};
						} else {
							$map{$to} = {from => $from,
								     module => $p};
						}
					}
				}
				*{$ns . 'AUTOLOAD'} = sub {
					# "fully qualified name of the original subroutine".
					my $q = our $AUTOLOAD;
					# to avoid possibly overwrite @_ by successful regular expression match.
					my ($to) = do { $q =~ /.*::(.*)/ };
					my $u = $map{$to};
					my $from = $u->{from} || $to;
					for my $p ($u->{module} || @pkg) {
						#   calculate the actual file to be loaded thus avoid eval and
						# checking $@ mannually.
						_require $p;
						if (my $r = *{"${p}::$from"}{CODE}) {
							no warnings 'prototype';
							*$q = $r;
							# TODO: understand why using goto will lost context.
							#goto &$r;
							return &$r;
						}
					}
					confess("unable to autoload $q.");
				};
			} elsif ($q eq 'oautoload') {
				for my $p (@{+shift}) {
					my $r = $p =~ s|::|/|gr . '.pm';
					# ignore already loaded module.
					my $f = "${p}::AUTOLOAD";
					next if $INC{$r} or *$f{CODE};
					*$f = sub {
						my ($f) = do { our $AUTOLOAD =~ /.*::(.*)/ };
						my $symtab = *{"${p}::"}{HASH};
						delete $symtab->{AUTOLOAD};
						require $r;
						&{$symtab->{$f}};
					};
				}
			} elsif ($q eq 'sane') {
				($^H, ${^WARNING_BITS}, %^H) = @H;
			} else {
				confess("unknown request $q");
			}
		}
	};
	my @a = qw/Cpanel::JSON::XS JSON::XS JSON::PP/;
	App::rs->import(iautoload => ['Carp',
				      [qw'Compress::Zlib memGunzip'],
				      [qw/File::Path make_path/],
				      [qw'Socket getaddrinfo',
				       map { "&$_" } qw'AF_UNIX SOCK_STREAM MSG_NOSIGNAL']],
			oautoload => [@a]);
	my $o;
	for (@a) {
		last if eval {
			$o = $_->new->pretty->canonical;
		};
	}
	sub jw	{ $o->encode(shift) }
	sub jr	{ $o->decode(shift) }
}
sub xsh {
	my $f = shift;
	if (not ref $f) {
		my $h = {};
		$h->{"capture-stdout"} = 1 if $f & 1;
		$h->{"feed-stdin"} = 1 if $f & 2;
		$f = $h;
	}
	my ($h, $i, $pr, @st) = ({pid => []}, 0);
	if ($f->{"feed-stdin"}) {
		my ($fi, $pid) = shift;
		pipe $pr, my $pw;
		if (not $pid = fork) {
			close $pr;
			print $pw $fi;
			exit;
		} else {
			push @{$h->{pid}}, $pid;
		}
	}
	while ($i <= @_) {
		my $l = $i == @_;
		my $a = $_[$i] if not $l;
		if ($l or $a eq "|") {
			pipe my $r, my $w if not $l or $f->{"capture-stdout"};
			# there's no need to fork when executing the last command and we're required
			# to substitute current process.
			my $pid = fork unless $l and $f->{substitute};
			if (not $pid) {
				# always true except possibly the first.
				open STDIN, "<&", $pr if $pr;
				# always true except possibly the last.
				open STDOUT, ">&", $w if $w;
				while (ref $st[-1]) {
					my ($h, $f) = pop @st;
					if (ref \$h->{from} eq "SCALAR")	{ open $f, $h->{mode}, $h->{from} or die $! }
					else					{ $f = $h->{from} }
					open $h->{to}, $h->{mode} . "&", $f;
				}
				exec @st;
			} else {
				$pr = $r;
				push @{$h->{pid}}, $pid;
				@st = ();
			}