CMS/Simple/Parse.pm

   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 ;