Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Regex Question

by jedikaiti (Hermit)
on Nov 07, 2016 at 20:54 UTC ( #1175466=perlquestion: print w/replies, xml ) Need Help??

jedikaiti has asked for the wisdom of the Perl Monks concerning the following question:

To start: I have a file that looks a bit like what's below, format-wise:
/* SOME COMMENT HERE */ /* MORE COMMENT */ /* Description - information */ options { option1 value; option2 value; option3 "value"; option4 { value1; value2; }; }; /* identifier1 ID 123456 */ object "identifier1" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* identifier2 ID 234561 */ object "identifier2" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* identifier3 ID 345612 */ object "identifier3" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* EOF */

I hope the anonymzing isn't too problematic.

At any rate, I need to pull data out of this file, and I can't guarantee the availability of any non-core modules on whatever system this ends up running on.

So, step 1 for me, is to get all the bits starting with object ... { and going until the next }; pulled out so I can deal with them from there. I'm thinking a regex that will grab each instance as a single multi-line string, and shoving them all into an array, but I'm open to suggestions. Each file may have rather a lot of these objects, but unfortunately I have no way of determining how many in advance.

What I've tried: I've been playing on Regex101 to test some various ideas and try to tweak a possible regex match. They don't have anything Perl-specific, but I've found it handy in the past for testing and tweaking. Alas, I keep ending up with everything or nothing. Getting the opening line or the closing line for each object is easy enough, but grabbing both and whever happens to be in between them is proving more problematic, and I end up with the everything-or-nothing problem.

Help, monks? Am I missing some blatently obvious solution?


What part of v_e = sqrt(2GM/r) don't you understand? It's only rocket science!

Replies are listed 'Best First'.
Re: Regex Question
by NetWallah (Canon) on Nov 07, 2016 at 21:23 UTC
Re: Regex Question (rec desc)
by tye (Sage) on Nov 07, 2016 at 23:06 UTC

    You just write a recursive-descent parser. Doing that is pretty easy. Here's most of one:

    #!/usr/bin/perl -w use strict; use Data::Dumper 'Dumper'; my %Data; my $Comment = '/[*]([^*]+|[*]+[^*/])*[*]/'; my $Name = '([a-zA-Z_][a-zA-Z0-9_]*)'; my $Quoted = '"([^"]*)"'; local $/; my $code = <DATA>; parse( \$code ); print Dumper( \%Data ); exit; sub parse { my( $svCode ) = @_; skip( $svCode ); while( $$svCode !~ /\G\z/gc ) { if( $$svCode =~ /\Goptions(?!\w)/gc ) { parseOptions( $svCode ); } elsif( $$svCode =~ /\Gobject(?!\w)/gc ) { parseObject( $svCode ); } else { fail( $svCode, "Expected 'options' or 'object'" ); } skip( $svCode ); } } sub skip { my( $svCode ) = @_; 0 while $$svCode =~ /\G\s+/gc || $$svCode =~ /\G$Comment/gc; } sub expect { my( $svCode, $re, $desc ) = @_; skip( $svCode ); fail( $svCode, "Expected ", $desc ) if $$svCode !~ /\G$re/gc; my $return = $1; skip( $svCode ); return $return; } sub fail { my( $svCode, @error ) = @_; my $pos = pos $$svCode; my $before = substr( $$svCode, 0, $pos ); my $line = 1 + ( $before =~ tr/\n/\n/ ); my $col = 1 + length( $before =~ /([^\n]*)\z/ ? $1 : '' ); my $next = $$svCode =~ /\G([^\n]{1,8})/gc ? $1 : undef; die @error, " at line $line, col $col, before '$next'.\n" if defined $next; my $after = $before =~ /([^\n]{1,8})\z/ ? $1 : undef; die @error, " at line $line, col $col, after '$after'.\n" if defined $after; die @error, " at line $line, col $col.\n"; } sub parseOptions { my( $svCode ) = @_; expect( $svCode, '[{]', "'{' after 'options'" ); while( $$svCode !~ /\G[}]/gc ) { my $name = expect( $svCode, $Name, 'option name' ); if( $$svCode =~ /\G$Name/gc ) { $Data{''}{$name} = $1; } elsif( $$svCode =~ /\G$Quoted/gc ) { # TODO: Unescape things that can be escaped inside quo +tes $Data{''}{$name} = $1; } elsif( $$svCode =~ /\G[{]/gc ) { parseListOption( $svCode, $name ); } elsif( $$svCode =~ /\G\z/gc ) { fail( $svCode, "Missing '}' at end of options" ); } else { fail( $svCode, "Unsupported value for option '$name'" +); } expect( $svCode, ';', "';' after option '$name'" ); } expect( $svCode, ';', "';' after options" ); } sub parseListOption { my( $svCode, $name ) = @_; skip( $svCode ); my @values; while( $$svCode !~ /\G[}]/gc ) { skip( $svCode ); if( $$svCode =~ /\G$Name/gc ) { push @values, $1; } elsif( $$svCode =~ /\G$Quoted/gc ) { # TODO: Unescape things that can be escaped inside quo +tes push @values, $1; } elsif( $$svCode =~ /\G\z/gc ) { fail( $svCode, "Missing '}' at end of list of option ' +$name'" ); } else { fail( $svCode, "Unsupported value in list of option '$ +name'" ); } expect( $svCode, ';', "';' after value in list of option ' +$name'" ); } $Data{''}{$name} = \@values; } sub parseListObject { my( $svCode, $obj, $name ) = @_; skip( $svCode ); my @values; while( $$svCode !~ /\G[}]/gc ) { skip( $svCode ); if( $$svCode =~ /\G$Name/gc ) { push @values, $1; } elsif( $$svCode =~ /\G$Quoted/gc ) { # TODO: Unescape things that can be escaped inside quo +tes push @values, $1; } elsif( $$svCode =~ /\G\z/gc ) { fail( $svCode, "Missing '}' at end of list '$obj'.'$na +me'" ); } else { fail( $svCode, "Unsupported value in list of '$obj'.'$ +name'" ); } expect( $svCode, ';', "';' after value in list of '$obj'.' +$name'" ); } $Data{$obj}{$name} = \@values; } sub parseObject { my( $svCode ) = @_; my $obj = expect( $svCode, $Quoted, 'object name' ); # TODO: Unescape things that can be escaped inside object name +s expect( $svCode, 'in', "'in' after object '$obj'" ); expect( $svCode, '[{]', "'{' for object '$obj'" ); while( $$svCode !~ /\G[}]/gc ) { my $name = expect( $svCode, $Name, "option name for object + '$obj'" ); if( $$svCode =~ /\G$Name/gc ) { $Data{$obj}{$name} = $1; } elsif( $$svCode =~ /\G$Quoted/gc ) { # TODO: Unescape things that can be escaped inside quo +tes $Data{$obj}{$name} = $1; } elsif( $$svCode =~ /\G[{]/gc ) { parseListObject( $svCode, $obj, $name ); } elsif( $$svCode =~ /\G\z/gc ) { fail( $svCode, "Missing '}' at end of object '$obj'" ) +; } else { fail( $svCode, "Unsupported value for '$obj'.'$name'" +); } expect( $svCode, ';', "';' after '$obj'.'$name'" ); } expect( $svCode, ';', "';' after object '$obj'" ); } __END__ /* SOME COMMENT HERE */ /* MORE COMMENT */ /* Description - information */ options { option1 value; option2 value; option3 "value"; option4 { value1; value2; }; }; /* identifier1 ID 123456 */ object "identifier1" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* identifier2 ID 234561 */ object "identifier2" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* identifier3 ID 345612 */ object "identifier3" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* EOF */

    And it even runs:

    $VAR1 = { '' => { 'option1' => 'value', 'option2' => 'value', 'option3' => 'value', 'option4' => [ 'value1', 'value2' ], }, 'identifier1' => { 'option1' => 'value', 'option2' => 'value', 'option3' => [ 'value1', 'value2' ], 'option4' => [ 'value' ], }, 'identifier2' => { 'option1' => 'value', 'option2' => 'value', 'option3' => [ 'value1', 'value2' ], 'option4' => [ 'value' ], }, 'identifier3' => { 'option1' => 'value', 'option2' => 'value', 'option3' => [ 'value1', 'value2' ], 'option4' => [ 'value' ], }, };

    - tye        

Re: Regex Question
by tybalt89 (Prior) on Nov 07, 2016 at 21:08 UTC
    #!/usr/bin/perl # http://perlmonks.org/?node_id=1175466 use strict; use warnings; $_ = do { local $/; <DATA> }; print $1 while /^(object.*?^\};\n)/gms; __DATA__ /* SOME COMMENT HERE */ /* MORE COMMENT */ /* Description - information */ options { option1 value; option2 value; option3 "value"; option4 { value1; value2; }; }; /* identifier1 ID 123456 */ object "identifier1" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* identifier2 ID 234561 */ object "identifier2" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* identifier3 ID 345612 */ object "identifier3" in { option1 value; option2 "value"; option3 { value1; value2; }; option4 { value; }; }; /* EOF */
Re: Regex Question
by AnomalousMonk (Bishop) on Nov 07, 2016 at 21:40 UTC
    ... I can't guarantee the availability of any non-core modules on whatever system this ends up running on.

    It's also useful to know if some minimal Perl version can be expected or not. Ferinstance, version 5.10 adds a bunch of really neat regex extensions, e.g., the recursive  (?PARNO) pattern family.

    It's also good to know if the format of the data is as strict as is suggested by your OPed example data; tybalt89's solution depends on the opening keyword and terminal delimiter of each
        object "identifier" in { ... };
    group both desperately hugging the left margin, and any departure from this will sink you.


    Give a man a fish:  <%-{-{-{-<

      Good points.

      For version, 5.10 appears to be the likely minimum - likely enough that anyone stuck with something earlier can be safely told they're on their own.

      The data is, in fact, that strict. If it's not, there are likely bigger problems at work.

      Many thanks!


      What part of v_e = sqrt(2GM/r) don't you understand? It's only rocket science!

        Also be aware that the list of core modules can vary between versions. I've never personally encountered a problem with this; however, if it is an issue for you, you can specify a range of valid versions with use and no.

        Version too old:

        $ perl -v | head -2 | tail -1 This is perl 5, version 18, subversion 0 (v5.18.0) built for darwin-th +read-multi-2level $ perl -e 'use 5.020; no 5.024' Perl v5.20.0 required--this is only v5.18.0, stopped at -e line 1. BEGIN failed--compilation aborted at -e line 1. $

        Version too new:

        $ perl -v | head -2 | tail -1 This is perl 5, version 24, subversion 0 (v5.24.0) built for darwin-th +read-multi-2level $ perl -e 'use 5.020; no 5.024' Perls since v5.24.0 too modern--this is v5.24.0, stopped at -e line 1. BEGIN failed--compilation aborted at -e line 1. $

        Version just right (Goldilocks zone):

        $ perl -v | head -2 | tail -1 This is perl 5, version 22, subversion 0 (v5.22.0) built for darwin-th +read-multi-2level $ perl -e 'use 5.020; no 5.024' $

        — Ken

Re: Regex Question
by jedikaiti (Hermit) on Nov 07, 2016 at 23:16 UTC

    You guys are awesome!


    What part of v_e = sqrt(2GM/r) don't you understand? It's only rocket science!

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1175466]
Approved by Corion
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2020-10-26 14:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (251 votes). Check out past polls.

    Notices?