Re: Extracting information from a Text widget

I have a Text widget ($text) that contains text that I've read in from a file. It looks something like this:

...

I need to find all the circles, grab their names, and put them into an array (to then be read into a tree widget, but that's another topic).

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper qw(Dumper);

{
    my $data = do { local $/; <DATA> };
    $data =~ s/^ Shapes \s+? \{ (.*) \} \s+ $/$1/sx;
    
    my @chunks;
    push @chunks, [ $1, $2, $3 ] 
      while $data =~ /
                      Shape=Circle \s+ 
                       \{ \s+ 
                          name=(\w+)     \s+ 
                          diameter=(\d+) \s+ 
                          color=(\w+)    \s+ 
                       \}
                     /gsx;
             
    print Dumper \@chunks;
}

__DATA__
Shapes
{
  Shape=Circle
  {
    name=joe
    diameter=3
    color=blue
  }
  Shape=Circle
  {
    name=steve
    diameter=5
    color=red
  }
}
[download]

outputs

$VAR1 = [
          [
            'joe',
            '3',
            'blue'
          ],
          [
            'steve',
            '5',
            'red'
          ]
        ];
[download]

Comment on Re: Extracting information from a Text widget Select or Download Code

Replies are listed 'Best First'.
Re^2: Extracting information from a Text widget by jlnelson19 (Initiate) on Jul 03, 2007 at 17:58 UTC
Thanks shigetsu, this works. I just need to figure out how to also extract the line.char info from where the matches were found in the text window.	[reply]
Re^2: Extracting information from a Text widget by jlnelson19 (Initiate) on Jul 05, 2007 at 21:49 UTC
How could this be modified to account for other text? For example: `Shapes { Shape=Circle { name=joe diameter=3 color=blue { random stuff { further depth } } } }` [download] I think this just comes down to creating the right regex, but nothing I've tried is able to ignore the rest of the text. I still just want the circle and it's name. thx	[reply] [d/l]
Re^3: Extracting information from a Text widget by BrowserUk (Patriarch) on Jul 06, 2007 at 05:02 UTC
This will parse the format you've indicated. It's pretty flexible about whitespace and accepts comments in most of the obvious places. It produces the HoAoHs you see at the bottom of the page which gives you access to everything you need. As requested above, it parses, but ignores nested blocks below the first level. It should deal with any number of Shape types and any number of key/value attribute pairs. Both key and value must not contain spaces. #! perl -slw use strict; use re qw[ eval ]; use Data::Dump; my %shapes; my( $type, $key, $value ); my $reComment = qr[ \# .? \n \s ]x; my $reWS = qr[ \s* \| $reComment ]smx; my $reNestedBlock; $reNestedBlock = qr[ \{ (?> [^{}]+ \| (??{ $reNestedBlock }) )+ \} $reWS ]smx; my $reAttribs = qr[ $reComment \| ( (?> \w+ ) ) (?{ $key = $^N }) \s* = \s* ( \S+ ) (?{ $value = $^N }) (?{ $shapes{ $type }[-1]{ $key } = $value }) $reWS ]smx; my $reShape = qr[ $reComment \| Shape \s* = \s* ( (?> \w+ ) ) (?{ push @{ $shapes{ $type = $^N } }, {} }) $reWS+ \{ $reWS (?> $reAttribs+ ) $reNestedBlock? \} $reWS ]smx; my $reShapes = qr[ Shapes $reWS \{ $reWS $reShape+ \} ]smx; do{ local $/; <DATA> } =~ $reShapes or die "Failed to match!"; print dump \%shapes; __DATA__ Shapes { Shape=Circle # A comment { name= joe diameter=3 color=blue # A comment } ## Another one Shape=Triangle{ name=Equilateral sides=3,3,3 color=green } Shape=Triangle{ name = Right sides = 3,4,5 color = green } Shape=Circle { name=steve diameter=5 color=red } Shape=Square { name=steve2 size=5 color=black } Shape = Square { name=fred2 size=3 color=yellow { random stuff { {{{{{{{{{{{{{{{fred}}}}}}}}}}}}}}} } } } Shape=Circle { # A comment name = fred # a comment diameter = 3 color = blue { random stuff { further depth } } } } [download] Output: `C:\test>624564 { Circle => [ { color => "blue", diameter => 3, name => "joe" }, { color => "red", diameter => 5, name => "steve" }, { color => "blue", diameter => 3, name => "fred" }, ], Square => [ { color => "black", name => "steve2", size => 5 }, { color => "yellow", name => "fred2", size => 3 }, ], Triangle => [ { color => "green", name => "Equilateral", sides => "3 +,3,3" }, { color => "green", name => "Right", sides => "3,4,5" +}, ], }` [download] Two caveats: When it fails, it doesn't tell you why or where. That's why I added the comment facility, it makes it resonably quick to locate errors. I'm not offering to maintain or extend it for you. It's not horribly complicated, and with a little study you should be able to work out how to extend it if you need to. I don't mind answering questions to help you, but do not expect to be able to ask for feature XYZ and just get code back. Ask for help in implemeting XYZ, post your attempt, and you'll probably get it. Bear those in mind before you decide to use the above code. Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice. "Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."	[reply] [d/l] [select]


go ahead... be a heretic
	PerlMonks