Re^2: Help with regular expression

Whoa, modifying and matching the same string? That can get tricky :) You appear to collapse whitespace ( "REM SSS" becomes "REMSSS" )

Here is a familiar pattern I've used before, jazzed up with perlfaq6#What good is \G in a regular expression?

#!/usr/bin/perl --
use strict; use warnings; use Data::Dump;

Main( @ARGV );
exit( 0 );

sub Main {
    my $pp = q{
(S= (SN=ac2.bd)
    (I1=
        (IN=s%1)
        (NM=1)
        (HL=(HLD=kkk kjkjk)
                (ST=abdc)
                (HI=REM SSS)
                (H_M=9)
                (HL=72)
                (EB=0)
                (ER=0)
                (HI=E043-93A-DF0-0AB63E)
                (PE=aaa)
                (HN=DEE)
                (SS=NS)
                (SED=
                    (
                        APR=(PAD=kkk)
                        (PN=9905)
                        (HH=llkjk)
                    )
                    (DD=(LLL=kkk))
                )
        )
        (ppp=1)
        (RAW=kkk)
        (DN=kkk)
        (RIN=ppp)
    )
    (PPP=1)
    (AA=LLI)
)};
    dd blahs2aoa("");
    dd blahs2aoa( $pp );
}

#~ What good is \G in a regular expression?
#~ http://perldoc.perl.org/perlfaq6.html#What-good-is-\G-in-a-regular-
+expression%3f

sub blahs2aoa {
    my $curr_stack = my $root = [] ;
    my $prev_stack;
    
    local $_ = $_[0];
    pos = 0;
    while( length > pos ){
        
        m/\G\s++/gcx    and next;    
        m/\G\s++/gcx    and next;    # ignore space "greedily"
                                     # ignore space without backtracki
+ng
                                     # Match 1 or more times and give 
+nothing back
                                     # ?? ignore space while ratchetin
+g
                                     # ?? ratchet and ignore space 
        
        m/\G=/gcx       and next;    # ignore equals
        m/\G\(/gcx      and do {     # open
            push @$curr_stack, [] ;
            push @$prev_stack, $curr_stack;
            $curr_stack = $$curr_stack[-1];
            next;
        };
        m/\G\)/gcx      and do {     # close
            if( @$prev_stack ){
                $curr_stack = pop @$prev_stack;
            } else {
                warn join ' ', "error extra ) close at pos ", pos, "\n
+";
            }
            next;
        };
        m/\G([^\(\)=]++)/gcx and do { # key or value
            push @$curr_stack, $1;
            next;
        };
    }
    
    if( $prev_stack  and @$prev_stack ){
        warn "Trouble!\nprev_stack ", int @$prev_stack , "\n",
        'curr_stack ', int @$curr_stack , "\n", 
        Data::Dump::pp({ prev => $prev_stack, curr => $curr_stack }), 
+"\n";
    }
    return $root;
}
__END__
[]
[
  [
    "S",
    ["SN", "ac2.bd"],
    [
      "I1",
      ["IN", "s%1"],
      ["NM", 1],
      [
        "HL",
        ["HLD", "kkk kjkjk"],
        ["ST", "abdc"],
        ["HI", "REM SSS"],
        ["H_M", 9],
        ["HL", 72],
        ["EB", 0],
        ["ER", 0],
        ["HI", "E043-93A-DF0-0AB63E"],
        ["PE", "aaa"],
        ["HN", "DEE"],
        ["SS", "NS"],
        [
          "SED",
          ["APR", ["PAD", "kkk"], ["PN", 9905], ["HH", "llkjk"]],
          ["DD", ["LLL", "kkk"]],
        ],
      ],
      ["ppp", 1],
      ["RAW", "kkk"],
      ["DN", "kkk"],
      ["RIN", "ppp"],
    ],
    ["PPP", 1],
    ["AA", "LLI"],
  ],
]
[download]

Comment on Re^2: Help with regular expression Download Code

Replies are listed 'Best First'.

Re^3: Help with regular expression
by Anonymous Monk on Oct 11, 2012 at 12:51 UTC

You can turn that into choroba-s hashy structure using Data::Rmap

#!/usr/bin/perl --
use strict; use warnings; use Data::Dump;

my $blah = (
  [
    "S",
    ["SN", "ac2.bd"],
    [
      "I1",
      ["IN", "s%1"],
      ["NM", 1],
      [
        "HL",
        ["HLD", "kkk kjkjk"],
        ["ST", "abdc"],
        ["HI", "REM SSS"],
        ["H_M", 9],
        ["HL", 72],
        ["EB", 0],
        ["ER", 0],
        ["HI", "E043-93A-DF0-0AB63E"],
        ["PE", "aaa"],
        ["HN", "DEE"],
        ["SS", "NS"],
        [
          "SED",
          ["APR", ["PAD", "kkk"], ["PN", 9905], ["HH", "llkjk"]],
          ["DD", ["LLL", "kkk"]],
        ],
      ],
      ["ppp", 1],
      ["RAW", "kkk"],
      ["DN", "kkk"],
      ["RIN", "ppp"],
    ],
    ["PPP", 1],
    ["AA", "LLI"],
  ],
);


use Data::Rmap qw/ rmap_array  /;
rmap_array {
    my( $key, $val, @rest ) = @$_;
    if( not ref $key ){
        if( @rest ){
            $_ = { $key, [ $val, @rest ] };
        } else {
            $_ = { $key, $val };
        }
    }
    return;
} $blah;
dd $blah;
__END__
{
  S => [
         { SN => "ac2.bd" },
         {
           I1 => [
                   { IN => "s%1" },
                   { NM => 1 },
                   {
                     HL => [
                             { HLD => "kkk kjkjk" },
                             { ST => "abdc" },
                             { HI => "REM SSS" },
                             { H_M => 9 },
                             { HL => 72 },
                             { EB => 0 },
                             { ER => 0 },
                             { HI => "E043-93A-DF0-0AB63E" },
                             { PE => "aaa" },
                             { HN => "DEE" },
                             { SS => "NS" },
                             {
                               SED => [
                                        { APR => [{ PAD => "kkk" }, { 
+PN => 9905 }, { HH => "llkjk" }] },
                                        { DD => { LLL => "kkk" } },
                                      ],
                             },
                           ],
                   },
                   { ppp => 1 },
                   { RAW => "kkk" },
                   { DN => "kkk" },
                   { RIN => "ppp" },
                 ],
         },
         { PPP => 1 },
         { AA => "LLI" },
       ],
}
[download]

[reply]
[d/l]


Your skill will accomplish what the force of many cannot
	PerlMonks