Commit | Line | Data |
9e609156 |
1 | package CMS::Simple::Parse ; |
2 | |
3 | |
4 | use strict ; |
5 | use warnings ; |
6 | |
7 | use Data::Dumper ; |
8 | |
9 | sub parse_content { |
10 | |
11 | my( $text ) = @_ ; |
12 | |
13 | #print $text ; |
14 | |
15 | my $lines = [ $text =~ m{(.*?$/)}sg ] ; |
16 | |
17 | return parse_lines( {}, $lines ) ; |
18 | } |
19 | |
20 | sub parse_lines { |
21 | |
22 | my( $curr_hash, $lines ) = @_ ; |
23 | |
24 | my $content = '' ; |
25 | my $scalar_tag ; |
26 | |
27 | while( my $line = shift @{$lines} ) { |
28 | |
29 | # skip blank lines |
30 | |
31 | # next unless $line =~ /\S/ ; |
32 | |
33 | # look for tag:: lines and parse them out. |
34 | # ignore leading white space, grad for a word followed by 1 or 2 :'s. |
35 | # also grab any optional content following the tag |
36 | |
37 | unless( $line =~ /^\s*(\w+)(::?)\s+(.*)\z/s ) { |
38 | |
39 | # no tag found so just add this line to the current scalar content |
40 | |
41 | $content .= $line ; |
42 | next ; |
43 | } |
44 | |
45 | my $tag = $1 ; |
46 | |
47 | # save any existing scalar as we found a new tag entry |
48 | |
49 | if ( $scalar_tag ) { |
50 | _store_value( $curr_hash, $scalar_tag, $content ) ; |
51 | $scalar_tag = '' ; |
52 | } |
53 | |
54 | # see we at the end of a structure. if so, return what we have parsed |
55 | |
56 | return $curr_hash if $tag eq 'END' ; |
57 | |
58 | # see if this a start of a structure. if so, recursively parse and |
59 | # store it any content on the structure tag line is ignored. its value |
60 | # is always a hash ref of the structure data. |
61 | |
62 | if( $2 eq '::' ) { |
63 | |
64 | my $new_val = parse_lines( {}, $lines ) ; |
65 | _store_value( $curr_hash, $tag, $new_val ) ; |
66 | next ; |
67 | } |
68 | |
69 | # now it must be a new scalar entry. save any new content on this line |
70 | |
71 | $scalar_tag = $tag ; |
72 | $content = $3 ; |
73 | } |
74 | |
75 | #print "TAG $scalar_tag\n" ; |
76 | _store_value( $curr_hash, $scalar_tag, $content ) if $scalar_tag ; |
77 | |
78 | #print Dumper $curr_hash ; |
79 | |
80 | return $curr_hash ; |
81 | } |
82 | |
83 | sub _store_value { |
84 | |
85 | my( $curr_ref, $tag, $val ) = @_ ; |
86 | |
87 | # NOTE: always chomping scalar content |
88 | |
89 | chomp $val unless ref $val ; |
90 | |
91 | my $curr_val = $curr_ref->{$tag} ; |
92 | |
93 | |
94 | unless( defined $curr_val ) { |
95 | |
96 | #print "NEW TAG $tag [$val]\n" ; |
97 | |
98 | $curr_ref->{$tag} = $val ; |
99 | return ; |
100 | } |
101 | |
102 | if ( ref $curr_val eq 'ARRAY' ) { |
103 | |
104 | #print "PUSH TAG $tag [$val]\n" ; |
105 | |
106 | push( @{$curr_val}, $val ) ; |
107 | |
108 | return ; |
109 | } |
110 | |
111 | #print "ARRAY TAG $tag [$val]\n" ; |
112 | $curr_ref->{$tag} = [ $curr_val, $val ] ; |
113 | |
114 | } |
115 | |
116 | # cheapo csv tab file parser |
117 | |
118 | sub parse_csv { |
119 | |
120 | my( $text ) = @_ ; |
121 | |
122 | my @lines = split m{(?<=$/)}, $text ; |
123 | |
124 | chomp @lines ; |
125 | |
126 | return [ map [ split /\t/ ], @lines ] ; |
127 | } |
128 | |
129 | 1 ; |