view release on metacpan or  search on metacpan

lib/XML/XSH2/Functions.pm  view on Meta::CPAN

  $_newdoc=1;
  $_die_on_err=1;
  $_want_returns=0;

  autoflush STDOUT;
  autoflush STDERR;
  $lexical_variables = [];
  $Xinclude_prefix = 'http://www.w3.org/2001/XInclude';
  require XML::XSH2::Commands;
}

sub VERSION {
  shift if $_[0] eq __PACKAGE__;
  my $ver = shift;
  if (defined($ver)) {
    my @V = split /\./,$VERSION;
    my @v = split /\./,$ver;
    for my $component (@v) {
      croak __PACKAGE__." version $ver required--this is only version $VERSION"
	if $component > shift @V;
    }
  }
  return $VERSION;
}


sub min { $_[0] > $_[1] ? $_[1] : $_[0] }

sub out {
  if (ref($OUT) eq 'IO::Scalar') {
    $OUT->print(@_);
  } else {
    foreach (map(fromUTF8($ENCODING,$_), @_)) {
      my $l = length;
      my $i = 1;
      while ($l > $i*$MAXPRINTLENGTH) {
	print $OUT (substr($_,($i-1)*$MAXPRINTLENGTH,$MAXPRINTLENGTH));
	$i++;
      }
      print $OUT (substr($_,($i-1)*$MAXPRINTLENGTH)); # the rest
    }
  }
}

sub __debug {
  _err(@_);
}

sub __bug {
  _err("BUG: ",@_);
}

sub _tilde_expand {
  my ($filename)=@_;
  $filename=~s{^(\~[^\/]*)}{(glob($1))[0]}eg;

#   $filename =~ s{ ^ ~ ( [^/]* ) }
#     { $1
# 	? (getpwnam($1))[7]
# 	  : ( $ENV{HOME} || $ENV{LOGDIR}
# 		|| (getpwuid($>))[7]
# 	       )
# 	}ex;
  return $filename;
}

sub _ev_opts {
  my ($opts)=@_;
  return {} unless ref($opts);
  return $opts if ref($opts) eq 'HASH';
  my %o;
  my @opts = @$opts;
  while (@opts) {
    my ($t,$n)=split /\//,shift(@opts);
    my $v=shift @opts;
    if ($t eq '' or $t eq 'exp') {
      $o { $n } = _ev($v);
    } elsif ($t eq 'var') {
      $o { $n } = $v;
    } elsif ($t eq 'xpath') {
      utf8::upgrade($v);
      $o { $n } = _expand($v);
    } else { # string
      $o { $n } = _ev_string($v);
    }
  }
  return \%o;
}

sub _hash_opts {
  my ($opts)=@_;
  return {} unless ref($opts);
  my %o;
  my @opts = @$opts;
  while (@opts) {
    my ($t,$n)=split /\//,shift(@opts);
    my $v=shift @opts;
    $o { $n } = $v;
  }
  return \%o;
}

sub alias_sr {
  my($src, $dest)=@_;
  tie($$dest, 'XML::XSH2::VarAlias', $src);
}

sub lexicalize {
  my $p="package XML::XSH2::Map; no strict qw(vars); \$Lexical::Alias::SWAP=0; use utf8;";
  my %seen;
  for (my $i=$#$lexical_variables; $i>=0; $i--) {
    foreach my $v (keys %{$lexical_variables->[$i]}) {
      next if $seen{$v};
      $seen{$v}=1;
      $p.="my \$$v; \&XML::XSH2::Functions::alias_sr(\\\$XML::XSH2::Functions::lexical_variables->[$i]{q#$v#}, \\\$$v);"
    }
  }
#  $p.="\n# line  $RT_LINE \"$RT_SCRIPT\"\n";
  return $p.$_[0];
}