1package setup::Parser; 2 3# Simple module to handle parsing in setup applications 4# primary in AppEdit, which need to do things like this more 5# often. 6# 7# setup::Parser objects can and should be treated EXACTLY 8# like a normal hash. That is, you shouldn't add normal 9# parser elements to the parser through the use of methods, 10# you can just $parser->{key} = $value 11# 12# What having the parser as an object does, is add a convenient 13# handle for running functions using the parser, when the functions 14# would otherwise just end up handing around in the application 15 16use strict; 17use UNIVERSAL 'isa'; 18use vars qw{@ISA}; 19BEGIN { @ISA = 'setup::Error' } 20 21 22 23 24 25##################################################################### 26# Class level configuration 27 28sub defaults { 29 return { 30 string => '\[(\w+)\]', 31 rootscan => '\[root_(\w+)\]', 32 replace_start => '[', 33 replace_end => ']', 34 }; 35} 36 37 38 39 40 41##################################################################### 42# Constructors and friends 43 44sub new { 45 my $class = shift; 46 my $self = ref $_[0] eq 'HASH' ? shift : {}; 47 bless $self, $class; 48 49 # Set the optional match ends 50 if ( ref $_[0] eq 'ARRAY' ) { 51 $self->{' __match'} = $_[0]; 52 } else { 53 $self->{' __match'} = $self->defaults; 54 } 55 $self->{' __safe_mode'} = 0; 56 57 return $self; 58} 59 60# Make a full copy of the existing parser 61sub clone { return bless {%{$_[0]}}, ref $_[0] } 62 63# "Safe Mode" parsing ONLY parses things it finds in the hash 64# Anything that isn't in the hash is explicitly left where it is 65# This can be handy for not breaking JavaScript, but is less 66# flexible, as you can't rely on something not being in the parser to 67# blank out a parser tag. 68sub safeMode { 69 my $self = shift; 70 if ( defined $_[0] ) { 71 $self->{' __safe_mode'} = $_[0] ? 1 : 0; 72 } 73 return $self->{' __safe_mode'}; 74} 75 76 77 78 79##################################################################### 80# Manipulating the parser 81 82# Add another parser to ours. Overwrite our elements 83sub add { 84 my $self = shift; 85 my $parser = shift; 86 return undef unless isa( $parser, 'HASH' ); 87 88 foreach ( keys %$parser ) { 89 $self->{$_} = $parser->{$_}; 90 } 91 return 1; 92} 93 94 95 96 97##################################################################### 98# Methods to do the parsing 99 100# Base parsing fuction 101# Accepts a large range of things to parse into and splits 102# into the appropriate functions 103sub parse { 104 my $self = shift; 105 my $content = shift; 106 107 if ( isa( $content, 'SCALAR' ) ) { 108 return $self->_parseScalar( $content ); 109 110 } elsif ( isa( $content, 'ARRAY' ) ) { 111 return $self->_parseArray( $content ); 112 113 } elsif ( ref $content ) { 114 return $self->andError( "Invalid argument to parser" ); 115 116 } elsif ( defined $content ) { 117 # To avoid copying the entire variable again, 118 # do the parsing by reference 119 my $result = $self->_parseScalar( \$content ); 120 return $result ? $content : undef; 121 122 } else { 123 return $self->andError( "Invalid argument to parser" ); 124 125 } 126} 127 128# Parse a reference to a scalar 129sub _parseScalar { 130 my $self = shift; 131 my $content = shift; 132 133 # Do the parsing 134 my $match = $self->{' __match'}->{string}; 135 if ( $self->{' __safe_mode'} ) { 136 $$content =~ s{$match} 137 {exists $self->{$1} 138 ? $self->{$1} 139 : ( $self->{' __match'}->{replacestart} . $1 . $self->{' __match'}->{replaceend} ) 140 }ge; 141 } else { 142 $$content =~ s/$match/$self->{$1}/g; 143 } 144 145 return $content; 146} 147 148# Takes a reference to an array 149sub _parseArray { 150 my $self = shift; 151 my $content = shift; 152 153 # Do the parsing 154 my $match = $self->{' __match'}->{string}; 155 if ( $self->{' __safe_mode'} ) { 156 foreach ( 0 .. $#$content ) { 157 $content->[$_] =~ s{$match} 158 {exists $self->{$1} 159 ? $self->{$1} 160 : ( $self->{' __match'}->{replacestart} . $1 . $self->{' __match'}->{replaceend} ) 161 }ge; 162 } 163 } else { 164 foreach ( 0 .. $#$content ) { 165 $content->[$_] =~ s/$match/$self->{$1}/g; 166 } 167 } 168 169 return $content; 170} 171 172 173 174 175##################################################################### 176# Scanning Methods 177 178# The scan method takes a content source ( scalar, scalar ref, array ref ) 179# and scans it to determine all the strings that match in the content, 180# returning it as a hash reference with the string as the key, and the 181# occurance count as the value 182# 183# It is worth noting that scanning can slow down the display process 184# It is only normally worth it in situations where only a small number 185# of a potentially large parser need to be created, or when creating 186# the parser entries may take a computationally non-trivial amount of time 187 188sub scan { 189 my $either = shift; 190 my $class = ref $either || $either; 191 my $content = shift; 192 my $root = shift; 193 194 # Find the match string 195 my $match = ref $either 196 ? defined $root 197 ? $either->{' __match'}->{rootscan} 198 : $class->defaults()->{rootscan} 199 : defined $root 200 ? $either->{' __match'}->{string} 201 : $class->defaults()->{string}; 202 $match =~ s/root/$root/g if defined $root; 203 204 # Split on argument type 205 if ( isa( $content, 'SCALAR' ) ) { 206 return $class->_scanScalar( $content, $match ); 207 208 } elsif ( isa( $content, 'ARRAY' ) ) { 209 return $class->_scanArray( $content, $match ); 210 211 } elsif ( ref $content ) { 212 return $class->andError( "Invalid argument to parser" ); 213 214 } elsif ( defined $content ) { 215 # To avoid copying the entire variable again, 216 # do the scanning by reference 217 return $class->_scanScalar( \$content, $match ); 218 219 } else { 220 return $class->andError( "Invalid argument to parser" ); 221 222 } 223} 224 225sub _scanScalar { 226 my $class = shift; 227 my $content = shift or return undef; 228 my $match = shift or return undef; 229 230 # Build and return the hash 231 my %hash = (); 232 $hash{$_}++ foreach $$content =~ m/$match/g; 233 return \%hash; 234} 235 236sub _scanArray { 237 my $class = shift; 238 my $content = shift or return undef; 239 my $match = shift or return undef; 240 241 # Build and return the hash 242 my %hash = (); 243 foreach my $i ( 0 .. $#$content ) { 244 $hash{$_}++ foreach ${$content->[$i]} =~ m/$match/g; 245 } 246 return \%hash; 247} 248 2491; 250