-#!/usr/bin/perl
+package Nomad;
# Suboptimal things:
# ast type info is generally still implicit
use P5AST;
use P5re;
-my $dowarn = 0;
-my $YAML = 0;
my $deinterpolate;
-while (@ARGV and $ARGV[0] =~ /^-./) {
- my $switch = shift;
- if ($switch eq '-w') {
- $dowarn = 1;
- }
- elsif ($switch eq '-Y') {
- $YAML = 1;
- }
- elsif ($switch eq '-d') {
- $deinterpolate = 1;
- }
- else {
- die "Unrecognized switch: -$switch";
+sub xml_to_p5 {
+ my %options = @_;
+
+
+ my $filename = $options{'input'} or die;
+ $deinterpolate = $options{'deinterpolate'};
+ my $YAML = $options{'YAML'};
+
+ local $SIG{__DIE__} = sub {
+ my $e = shift;
+ $e =~ s/\n$/\n [NODE $filename line $::prevstate->{line}]/ if $::prevstate;
+ confess $e;
+ };
+
+ # parse file
+ use XML::Parser;
+ my $p1 = XML::Parser->new(Style => 'Objects', Pkg => 'PLXML');
+ $p1->setHandlers('Char' => sub { warn "Chars $_[1]" if $_[1] =~ /\S/; });
+
+ # First slurp XML into tree of objects.
+
+ my $root = $p1->parsefile($filename);
+
+ # Now turn XML tree into something more like an AST.
+
+ PLXML::prepreproc($root->[0]);
+ my $ast = P5AST->new('Kids' => [$root->[0]->ast()]);
+ #::t($ast);
+
+ if ($YAML) {
+ require YAML::Syck;
+ return YAML::Syck::Dump($ast);
}
-}
-@ARGV = ('foo.xml') unless @ARGV;
-my $filename = shift;
+ # Finally, walk AST to produce new program.
+
+ my $text = $ast->p5text(); # returns encoded, must output raw
+ return $text;
+}
$::curstate = 0;
$::prevstate = 0;
'X' => 'p5::token',
);
-$SIG{__DIE__} = sub {
- my $e = shift;
- $e =~ s/\n$/\n [NODE $filename line $::prevstate->{line}]/ if $::prevstate;
- confess $e;
-};
-
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Quotekeys = 0;
use PLXML;
-use XML::Parser;
-my $p1 = new XML::Parser(Style => 'Objects', Pkg => 'PLXML');
-$p1->setHandlers('Char' => sub { warn "Chars $_[1]" if $_[1] =~ /\S/; });
-
-# First slurp XML into tree of objects.
-
-my $root = $p1->parsefile($filename);
-
-# Now turn XML tree into something more like an AST.
-
-PLXML::prepreproc($root->[0]);
-my $ast = P5AST->new('Kids' => [$root->[0]->ast()]);
-#::t($ast);
-
-if ($YAML) {
- require YAML::Syck;
- print YAML::Syck::Dump($ast);
- exit;
-}
-
-# Finally, walk AST to produce new program.
-
-my $text = $ast->p5text(); # returns encoded, must output raw
-print $text;
-
package p5::text;
use Encode;
sub madness {
my $self = shift;
my @keys = split(' ', shift);
+ @keys = map { $_ eq 'd' ? ('k', 'd') : $_ } @keys;
my @vals = ();
for my $key (@keys) {
my $madprop = $self->{mp}{$key};
for my $kid (@{$$self{Kids}}) {
my ($k,$v) = $kid->pair($self, @_);
$firstthing ||= $k;
- if ($k =~ /^[_#]$/) { # rekey whitespace according to preceding entry
- $k .= $lastthing; # (which is actually the token the whitespace is before)
- }
- else {
- $k .= 'x' while exists $hash{$k};
- $lastthing = $k;
- }
+ $k .= 'x' while exists $hash{$k};
+ $lastthing = $k;
$hash{$k} = $v;
}
$hash{FIRST} = $firstthing;
my @retval;
my @newkids;
- push @retval, $self->madness('M ox');
for my $kid (@{$$self{Kids}}) {
push @newkids, $kid->ast($self, @_);
}
sub ast {
my $self = shift;
- my @newkids = $self->madness('d M ox o (');
+ my @newkids = $self->madness('d o (');
if (exists $$self{Kids}) {
my $arg = $$self{Kids}[0];
my $self = shift;
my @newkids;
- push @newkids, $self->madness('M ox');
-
my $left = $$self{Kids}[0];
push @newkids, $left->ast($self, @_);
my $self = shift;
my @retval;
- my @before;
my @after;
- if (@before = $self->madness('M')) {
- push @before, $self->madness('ox'); # o is the function name
- }
if (@retval = $self->madness('X')) {
- push @before, $self->madness('o x');
+ my @before, $self->madness('o x');
return P5AST::listop->new(Kids => [@before,@retval]);
}
- push @retval, $self->madness('o ( [ {');
+ push @retval, $self->madness('o d ( [ {');
my @newkids;
for my $kid (@{$$self{Kids}}) {
push @retval, @newkids;
push @retval, $self->madness('} ] )');
- return $self->newtype->new(Kids => [@before,@retval,@after]);
+ return $self->newtype->new(Kids => [@retval,@after]);
}
package PLXML::logop;
my @args = $self->madness('A');
my $module = $module[-1]{Kids}[-1];
if ($module->uni eq 'bytes') {
- $::curenc = ::encnum('iso-8859-1');
+ $::curenc = Nomad::encnum('iso-8859-1');
}
elsif ($module->uni eq 'utf8') {
if ($$self{mp}{o} eq 'no') {
- $::curenc = ::encnum('iso-8859-1');
+ $::curenc = Nomad::encnum('iso-8859-1');
}
else {
- $::curenc = ::encnum('utf-8');
+ $::curenc = Nomad::encnum('utf-8');
}
}
elsif ($module->uni eq 'encoding') {
if ($$self{mp}{o} eq 'no') {
- $::curenc = ::encnum('iso-8859-1');
+ $::curenc = Nomad::encnum('iso-8859-1');
}
else {
- $::curenc = ::encnum(eval $args[0]->p5text); # XXX bletch
+ $::curenc = Nomad::encnum(eval $args[0]->p5text); # XXX bletch
}
}
# (Surrounding {} ends up here if use is only thing in block.)
if ($rfirst[-1]->uni ne $llast[-1]->uni) {
push @newkids, @rfirst;
}
-
+ # remove the fake '\n' if /e and '#' in replacement.
+ if (@mods and $mods[0] =~ m/e/ and ($self->madness('R'))[0]->uni =~ m/#/) {
+ unshift @rlast, bless {}, 'chomp'; # hack to remove '\n'
+ }
push @newkids, $bits->{repl}, @rlast, @mods;
my $retval = $self->newtype->new(Kids => [@newkids]);
my $self = shift;
my @newkids;
- my @before;
- if (@before = $self->madness('M')) {
- push @before, $self->madness('ox'); # o is the .
- }
my @after;
my $left = $$self{Kids}[0];
push @newkids, $left->ast($self, @_);
my $parent = $_[0];
my @newkids;
- my @before;
- if (@before = $self->madness('M')) {
- push @before, $self->madness('ox'); # o is the .
- }
my @after;
my $left = $$self{Kids}[0];
push @newkids, $left->ast($self, @_);
my $right = $$self{Kids}[1];
push @newkids, $right->ast($self, @_);
- return $self->newtype->new(Kids => [@before, @newkids, @after]);
+ return $self->newtype->new(Kids => [@newkids, @after]);
}
package PLXML::op_stringify;
package PLXML::op_unpack;
package PLXML::op_pack;
package PLXML::op_split;
-
-sub ast {
- my $self = shift;
- my $results = $self->SUPER::ast(@_);
- if (my @dest = $self->madness('R')) {
- return PLXML::op_aassign->newtype->new(Kids => [@dest, $self->madness('ox'), $results]);
- }
- return $results;
-}
-
package PLXML::op_join;
package PLXML::op_list;
package PLXML::op_leavewrite;
package PLXML::op_prtf;
package PLXML::op_print;
+package PLXML::op_say;
package PLXML::op_sysopen;
package PLXML::op_sysseek;
package PLXML::op_sysread;
projects / p5sagit/p5-mst-13.2.git / blobdiff