← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/horae/intrepid

« back to all changes in this revision

Viewing changes to 0CPAN/Parse-RecDescent-1.94/demo/demo_restructure_easy.pl

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/Parse-RecDescent-1.94/demo/demo_restructure_easy.pl
1
 
#!/usr/local/bin/perl -w
2
 
 
3
 
# CONVERT FROM ONE EXTERNAL STRUCTURE TO A
4
 
# SLIGHTLY DIFFERENT INTERNAL STRUCTURE
5
 
#
6
 
# LOCALIZED RULEVARS ARE ALWAYS EASIEST WHEN CHANGING STRUCTURES
7
 
# SEE demo_restructure_painful.pl FOR ANOTHER APPROACH THAT SHOWS WHY
8
 
 
9
 
use strict;
10
 
use Parse::RecDescent;
11
 
use Data::Dumper;
12
 
 
13
 
my $grammar = q(              
14
 
              
15
 
              file: <rulevar: local $file>
16
 
              file:  section(s)
17
 
                { $file }
18
 
                
19
 
              section:  header '{' body '}'
20
 
                { $file->{$item[1]} = $item[3] }
21
 
                
22
 
              header: 'Domain=' /.+/
23
 
                
24
 
              body: <rulevar: local $body>
25
 
              body: line(s)
26
 
                { $body }
27
 
                
28
 
              line: lineA | lineB
29
 
                
30
 
              lineA: /[^\W_]+/ '=' /.+/
31
 
                { $body->{$item[1]} = $item[3] }
32
 
                
33
 
              lineB: /[^\W_]+/ '_' /[^\W_]+/ '=' /.+/
34
 
                { $body->{$item[1]}{$item[3]} = $item[5] }
35
 
               );
36
 
 
37
 
my $parser = Parse::RecDescent->new($grammar);
38
 
my $text;
39
 
my @text = <DATA>;
40
 
 
41
 
foreach (@text)
42
 
{
43
 
    next if /^\#/;  # Strip comments
44
 
    $text .= $_;
45
 
}
46
 
 
47
 
my $f = $parser->file($text);
48
 
print Dumper ($f);
49
 
 
50
 
__DATA__
51
 
#
52
 
#
53
 
Domain=domain1
54
 
{
55
 
P1_Name=n1
56
 
P1_Address=host1:port1
57
 
 
58
 
P2_Name=n2
59
 
P2_Address=host2:port2
60
 
}
61
 
 
62
 
Domain=domain2
63
 
{
64
 
f1=v1
65
 
f2=v2a v2b
66
 
#comment
67
 
}