Re^2: Parsing a Variable Format String

[ozboomer]

OOooo, that's certainly elegant :)

I've been trying to get things happening... with some success.

My regex is still woeful... but I have a vague idea of what's going on here.. I still can't get the CT/CL items "usable" though, viz:

use Data::Dumper;

@opts = ( "SS  21M- PL 2#3  PV  51.3 CL #110 +0 RL 126' SA 106 DS 93",
          "SS  21 + PL 2.3  PVa51.3 CT^ 110 +0 RL126, SA 106 DS 93",
          "SS  21F  PL2#3#  PV   51.3 CL #110 +0 RL 126' SA 106 DS 93"
+,
          "SS  21#+ PL2.3#  PV   51.3 CL  110 -13 RL 126' SA 106 DS 93
+",
          "SS  32 - PL2.3#  PV   51.3 CL #110 +0 RL 126' SA 106 DS 93"
        );


my ($ss, $mstate, $mvote);

my %patterns = (
  qr/SS\s+(\d+)([MF# ])([\+\- ])/
    => sub { $ss = $1; $mstate = $2; $mvote = $3; },
    
#  qr/PL\s+([=#]?)(\d+)([=#]?)(\d+)/
#  qr/PL\s+(\d+)([\.\#])(\d+)([\.\#])/
  qr/PL\s*(\d+)([\#\.])(\d+)([\#\.]?)/
    => sub { $sp = $1; 
             $spl = $2; $spl = "" if ($spl ne "#");
             $lp = $3; 
             $lpl = $4; $lpl = "" if ($lpl ne "#");
           },
    
  qr/PV\s*([a-z]?\d+)(\.)(\d+)/
    => sub { $vsp = $1; $vlp = $3 },
    
  qr/RL\s+(\d+)([,'"]?)/
    => sub { $rl = $1; $rlflg = $2; },
    
  qr/SA\s+(\d+)/
    => sub { $csa = $1 },
    
  qr/DS\s+(\d+)/
    => sub { $cds = $1 },
    
  qr/CT\s+([#^]?)\s*(\d+)\s+(\S+)\s+(\S+)/,
    => sub { },
    
  qr/CL\s+([#^]?)(\d+)\s+(\S+)/,
    => sub { },
);

sub MAGIC {
  my $line = $_[0];
  $_ = {};
  $line =~ s/^\s*//;
printf("Input: >%s<\n", $line);
LOOP:
  while (length($line)) {
    for my $k (keys %patterns) {
      if ($line =~ s/^$k(?:\s+|\z)//) {
        $patterns{$k}->();
        next LOOP;
      }
    }
    warn "got stuck on: $line\n";
    $_->{leftover} = $line;
    last;
  }

   printf("    \$ss = $ss\n");
   printf("\$mstate = >$mstate<\n");
   printf(" \$mvote = >$mvote<\n");

   printf("   \$sp  = $sp\n");
   printf("   \$spl = $spl\n");
   printf("   \$lp  = $lp\n");
   printf("   \$lpl = $lpl\n");

   printf("   \$ctl = ...\n");
   printf("    \$ct = ...\n");
   printf("   \$ctr = ...\n");


   printf("   \$vsp = $vsp\n");
   printf("   \$vlp = $vlp\n");

   printf("    \$rl = $rl\n");
   printf(" \$rlflg = $rlflg\n");

   printf("   \$csa = $csa\n");
   printf("   \$cds = $cds\n");

  $_;
}


foreach $buf (@opts) {
   printf("START -----\n");
   MAGIC($buf);
#   print Dumper( MAGIC($buf));
   printf(" \n");
}

For example, for the 4th item in @opts, I would like to capture the info that:

Buf: "SS  21#+ PL2.3#  PV   51.3 CL  110 +13 RL 126' SA 106 DS 93"

Cycle Time = CT (or CL) = 110
Locks = (no #) = OFF
Rotation = "that number"  = 13

Many thanks for the assistance; I appreciate it a lot.

[planetscape]

My regex is still woeful...

In addition to the Pattern Matching, Regular Expressions, and Parsing section of our very fine Tutorials, you may also find the following helpful:

• Mastering Regular Expressions
• perlrequick
• perlretut
• perlre
• YAPE::Regex::Explain
• GraphViz::Regex
• The Regex Coach (Win32 only, IIRC)
• Regex Arcana
• txt2re: headache relief for programmers :: regular expression generator
• Regex tester
• Perl 5.10 Advanced Regular Expressions

Update:

• Online Regular Expression Analyzer, courtesy Ratazong (2010-08-11)

[Anonymous Monk]

To expand :) the list
wxPPIxregexplain.pl
ppixregexplain.pl
rxrx
http://regex101.com/ - Online regex tester and debugger: JavaScript, Python, PHP, and PCRE

[pc88mxer]

Something like:

  qr/(CT|CL)\s+([#]?)\s*(\d+)\s+(\S+)/,
    => sub { $_->{CTorCL} = $1;
             $_->{CycleTime} = $3;
             $_->{Locks} = ($2 eq "#" ? "ON" : "OFF");
             $_->{Rotation} = $4;
           }

Note I put the values in a hash. Otherwise you'll have to explicitly declare or reset your variables so one call won't interfere with subsequent calls.