Update Archive-Extract to cpan version 0.38
[p5sagit/p5-mst-13.2.git] / mad / Nomad.pm
old mode 100755 (executable)
new mode 100644 (file)
index 1378e7b..eaac474
@@ -440,6 +440,7 @@ sub newtype {
 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};
@@ -519,13 +520,8 @@ sub hash {
     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;
@@ -598,7 +594,6 @@ sub ast {
 
     my @retval;
     my @newkids;
-    push @retval, $self->madness('M ox');
     for my $kid (@{$$self{Kids}}) {
        push @newkids, $kid->ast($self, @_);
     }
@@ -615,7 +610,7 @@ package PLXML::baseop_unop;
 
 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];
@@ -632,8 +627,6 @@ sub ast {
     my $self = shift;
     my @newkids;
 
-    push @newkids, $self->madness('M ox');
-
     my $left = $$self{Kids}[0];
     push @newkids, $left->ast($self, @_);
 
@@ -675,17 +668,13 @@ sub ast {
     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}}) {
@@ -703,7 +692,7 @@ sub ast {
     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;
@@ -1694,7 +1683,10 @@ sub ast {
     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]);
@@ -1858,10 +1850,6 @@ sub astnull {
     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, @_);
@@ -1878,10 +1866,6 @@ sub ast {
     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, @_);
@@ -1891,7 +1875,7 @@ sub ast {
     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;
@@ -2214,16 +2198,6 @@ sub ast {
 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;
 
@@ -2864,6 +2838,7 @@ package PLXML::op_enterwrite;
 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;