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