ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/ActiveDoc/Switcher.pm

Comparing COMP/SCRAM/src/ActiveDoc/Switcher.pm (file contents):
Revision 1.8 by williamc, Wed Nov 17 17:57:33 1999 UTC vs.
Revision 1.22 by sashby, Tue Feb 27 13:34:49 2007 UTC

#	Line 6 | Line 6
6		# processed.
7		# Interface
8		# ---------
9	+	#
10		# new(file,objectref) : A new object -  filename of file to parse
11	<	#                                   objectref->of the methods
11	>	#                                       objectref->of the methods
12		# usetags(tagobjref)               : Specify a tagcontainer set to direct to
13		#                                    to the desired routines
14		# usegroupchecker(groupchecker)    : Set a groupchecker
15		# parse()                          : Parse the file
16	<	# line()                    : return the current line number of the parse
17	<	# stream(filehandle)        : stream output to the filehandle if not handled
18	<	#                               in any other way
16	>	# line()                           : return the current line number of the parse
17	>	# tagstartline()                   : return the line number on which the current
18	>	#                                    tag was opened
19	>	# stream(filehandle)               : stream output to the filehandle if not handled
20	>	#                                    in any other way
21		package ActiveDoc::Switcher;
22	+	use Utilities::Verbose;
23		require 5.001;
24		use Carp;
25
26	<	sub new {
23	<	my $class=shift;
24	<	my $file=shift;
25	<	my $objectname=shift;
26	<	my $groupchecker=shift;
27	<
28	<	$self = {};
29	<	$self->{allw}=$objectname;
30	<	bless $self, $class;
31	<	$self->_initialise($file);
32	<	return $self;
33	<	}
34	<
35	<	sub stream {
36	<	my $self=shift;
37	<
38	<	$self->{stream}=shift;
39	<	}
40	<
41	<	sub streamexclude {
42	<	my $self=shift;
43	<	my $tag=shift;
44	<
45	<	$tag=~tr/A-Z/a-z/;
46	<	$self->{streamexclude}{$tag}=1;
47	<	}
48	<
49	<	sub _initialise (hash1) {
50	<	my $self=shift;
51	<	$self->{filename}=shift;
52	<
53	<	# add a default groupchecker
54	<	use ActiveDoc::GroupChecker;
55	<	$self->{groupchecker}=GroupChecker->new();
56	<	$self->{groupchecker}->include("all");
57	<
58	<	# Add a default TagContainer
59	<	use ActiveDoc::TagContainer;
60	<	$self->{tagcontainer}=ActiveDoc::TagContainer->new();
61	<
62	<	}
63	<
64	<	sub usetags {
65	<	my $self=shift;
66	<	my $tagcontainer=shift;
67	<
68	<	$self->{tagcontainer}=$tagcontainer;
69	<	}
70	<
71	<	sub usegroupchecker {
72	<	my $self=shift;
73	<	my $ref=shift;
74	<
75	<	$self->{groupchecker}=$ref;
76	<	}
26	>	BEGIN { print __PACKAGE__." still used.\n"; exit(1) }
27
28	<	sub parse {
79	<	my $self=shift;
80	<	my $char;
81	<	my $buf;
82	<	$self->{linecount}=0;
83	<	$self->_resetvars();
84	<	$self->{streamstore}="";
85	<	$self->{streamtmp}="";
86	<
87	<	# Open the file
88	<	use FileHandle;
89	<	local $filehandle;
90	<	$filehandle=FileHandle->new();
91	<	$filehandle->open("<".$self->{filename})
92	<	or return 1;
93	<	# The buffering seems all messed up - best not to use it
94	<	$filehandle->setvbuf($buf, _IONBF, 3000);
95	<
96	<	# Start file processing
97	<	while ( ($_=<$filehandle>) ) {
98	<	$self->{linecount}++;
99	<	$self->{currentline}=$_;
100	<	$self->{stringpos}=0;
101	<	while ( ($char=$self->_nextchar()) ne "" ) {
102	<	$self->_checkchar($char);
103	<	} # end char while
104	<	} # End String while loop
105	<	undef $filehandle;
106	<	$self->_printstream();
107	<	}
28	>	@ISA=qw(Utilities::Verbose);
29
30	<	#
31	<	# return the current line number
32	<	#
33	<	sub line {
34	<	my $self=shift;
35	<	return $self->{linecount};
36	<	}
37	<	# --------------- Utility routines ----------------------------
38	<
39	<	#
40	<	# Some initialisation of test suites
41	<	#
42	<	sub _resetvars {
43	<	my $self=shift;
44	<	$self->{quotes}=0;
45	<	$self->{lastlabel}="";
46	<	$self->{textcontext}='none';
47	<	$self->{tagcontext}="text";
48	<	$self->_resetstore();
49	<	}
30	>	# sub new {
31	>	#       my $class=shift;
32	>	#       my $file=shift;
33	>	#       my $objectname=shift;
34	>	#       my $groupchecker=shift;
35	>
36	>	#       $self = {};
37	>	#       $self->{allw}=$objectname;
38	>	#       bless $self, $class;
39	>	#       $self->_initialise($file);
40	>	#       return $self;
41	>	# }
42	>
43	>	# sub stream {
44	>	#       my $self=shift;
45	>
46	>	#       $self->{stream}=shift;
47	>	# }
48	>
49	>	# sub streamexclude {
50	>	#       my $self=shift;
51	>	#       my $tag=shift;
52	>
53	>	#       $tag=~tr/A-Z/a-z/;
54	>	#       $self->{streamexclude}{$tag}=1;
55	>	# }
56	>
57	>	# sub _initialise (hash1)
58	>	#    {
59	>	#    my $self=shift;
60	>	#    $self->{filename}=shift;
61	>	#    $self->verbose(">> New ActiveDoc::Switcher created.");
62	>	#    # add a default groupchecker
63	>	#    use ActiveDoc::GroupChecker;
64	>	#    $self->{groupchecker}=GroupChecker->new();
65	>	#    $self->{groupchecker}->include("all");
66	>
67	>	#    # Add a default TagContainer
68	>	#    use ActiveDoc::TagContainer;
69	>	#    $self->{tagcontainer}=ActiveDoc::TagContainer->new();
70	>
71	>	#    }
72	>
73	>	# sub usetags {
74	>	#       my $self=shift;
75	>	#       my $tagcontainer=shift;
76	>
77	>	#       $self->{tagcontainer}=$tagcontainer;
78	>	# }
79	>
80	>	# sub usegroupchecker {
81	>	#       my $self=shift;
82	>	#       my $ref=shift;
83	>
84	>	#       $self->{groupchecker}=$ref;
85	>	# }
86
87	<	#
88	<	# Check for control characters
89	<	#
90	<	sub _checkchar {
91	<	my $self=shift;
92	<	my $char=shift;
93	<	my $string;
94	<
95	<
96	<	# ---- In a tag
97	<	if ( $self->{tagcontext}=~/tag/ ) {
98	<	if ( ! $self->_quotetest($char) ) {
99	<	if ( ! $self->_labeltest($char) ) {
100	<	if ( $char eq ">") { $self->_closetag(); }
101	<	else { $self->_putstore($char); }
145	<	}
146	<	}
147	<	}
148	<	# ------ Outside a tag
149	<	else {
150	<	if ( $char eq "<") { $self->_opentag() }
151	<	else { $self->_putstore($char) }
152	<	}
153	<	}
87	>	# sub parse {
88	>	#       my $self=shift;
89	>	#       my $char;
90	>	#       my $buf;
91	>	#       $self->{linecount}=0;
92	>	#       $self->_resetvars();
93	>	#       $self->{streamstore}="";
94	>	#       $self->{streamtmp}="";
95	>
96	>	#       # Open the file
97	>	#       use FileHandle;
98	>	#       local $filehandle;
99	>	#       $filehandle=FileHandle->new();
100	>
101	>	#       $self->verbose(">> Reading file: ".$self->{filename}." ");
102
103	+	#       $filehandle->open("<".$self->{filename})
104	+	#          or return 1;
105
106	<	#
107	<	# Return the next character from the current string buffer
108	<	#
109	<	sub _nextchar() {
110	<	my $self=shift;
111	<	my $char;
112	<	$char=substr($self->{currentline},$self->{stringpos}++,1);
113	<	#       print "Debug : Fetching character $char\n";
114	<
115	<	# Keep a record for any stream processes
116	<	$self->{streamstore}=$self->{streamstore}.$char;
117	<
118	<	return $char;
119	<	}
120	<
121	<	sub _opentag {
122	<	my $self=shift;
123	<	my $char;
124	<
125	<	# Close the last text segment
126	<	$self->{streamtmp}=$self->_popstream();
127	<	$self->_calltag($self->{textcontext}, $self->{textcontext},
128	<	$self->_getstore());
129	<	$self->_resetstore();
130	<	$self->_resetlabels();
131	<
132	<	# Do we have an opening or closing tag?
133	<	if ( ($char=$self->_nextchar()) eq "/" ) { #we have a closing tag
134	<	$self->{tagcontext}="endtag";
135	<	}
136	<	else { # an opening tag
137	<	$self->{tagcontext}="starttag";
138	<	$self->_checkchar($char);
139	<	}
140	<	#print "\nDebug : Opening $self->{tagcontext}\n";
141	<	}
106	>	#       # Start file processing
107	>	#       while ( ($_=<$filehandle>) ) {
108	>	#        $self->{linecount}++;
109	>	#        # Skip lines that start with a hash. A better way
110	>	#        # of adding comments than ignore tags:
111	>	#        next if (/^#/);
112	>	#        $self->{currentline}=$_;
113	>	#        $self->{stringpos}=0;
114	>	#        while ( ($char=$self->_nextchar()) ne "" ) {
115	>	#          $self->_checkchar($char);
116	>	#        } # end char while
117	>	#       } # End String while loop
118	>	#       undef $filehandle;
119	>	#       # make sure we close the last buffer
120	>	#       $self->_calltag($self->{textcontext}, $self->{textcontext},
121	>	#                                                         $self->_getstore());
122	>	# }
123	>
124	>	# sub parsefilelist
125	>	#    {
126	>	#    my $self=shift;
127	>	#    my ($char,$buf);
128	>
129	>	#    $self->{linecount}=0;
130	>	#    $self->_resetvars();
131	>	#    $self->{streamstore}="";
132	>	#    $self->{streamtmp}="";
133	>
134	>	#    foreach my $buildfile (@{$self->{filename}})
135	>	#       {
136	>	#       if ( -f $buildfile)
137	>	#        {
138	>	#        # Open the file
139	>	#        use FileHandle;
140	>	#        local $filehandle;
141	>	#        $filehandle=FileHandle->new();
142	>	#        $self->verbose(">> Reading file: ".$buildfile." ");
143	>	#        $filehandle->open("<".$buildfile) or return 1;
144	>
145	>	#        # Start file processing
146	>	#        while ( ($_=<$filehandle>) )
147	>	#           {
148	>	#           $self->{linecount}++;
149	>	#           # Skip lines that start with a hash. A better way
150	>	#           # of adding comments than ignore tags:
151	>	#           next if (/^#/);
152	>	#           $self->{currentline}=$_;
153	>	#           $self->{stringpos}=0;
154	>	#           while ( ($char=$self->_nextchar()) ne "" )
155	>	#              {
156	>	#              $self->_checkchar($char);
157	>	#              } # end char while
158	>	#           } # End String while loop
159	>	#        undef $filehandle;
160	>	#        # Make sure we close the last buffer:
161	>	#        $self->_calltag($self->{textcontext}, $self->{textcontext},
162	>	#                        $self->_getstore());
163	>	#        }
164	>	#       }
165	>	#    }
166	>
167	>	# #
168	>	# # return the current line number
169	>	# #
170	>	# sub line {
171	>	#       my $self=shift;
172	>	#       return $self->{linecount};
173	>	# }
174	>
175	>	# # return the line the current tag was opened
176	>	# sub tagstartline {
177	>	#       my $self=shift;
178	>	#       $self->{tagstart};
179	>	# }
180	>	# # --------------- Utility routines ----------------------------
181	>
182	>	# #
183	>	# # Some initialisation of test suites
184	>	# #
185	>	# sub _resetvars {
186	>	#       my $self=shift;
187	>	#       $self->{quotes}=0;
188	>	#       $self->{lastlabel}="";
189	>	#       $self->{textcontext}='none';
190	>	#       $self->{tagcontext}="text";
191	>	#       $self->_resetstore();
192	>	# }
193	>
194	>	# #
195	>	# # Check for control characters
196	>	# #
197	>	# sub _checkchar {
198	>	#       my $self=shift;
199	>	#       my $char=shift;
200	>	#       my $string;
201	>
202	>
203	>	#         # ---- In a tag
204	>	#       if ( $self->{tagcontext}=~/tag/ ) {
205	>	#          $self->{tagbuff}=$self->{tagbuff}.$char;
206	>	#          if ( ! $self->_quotetest($char) ) {
207	>	#           if ( ! $self->_labeltest($char) ) {
208	>	#            if ( $char eq ">") { $self->_closetag(); }
209	>	#              else { $self->_putstore($char); }
210	>	#           }
211	>	#          }
212	>	#       }
213	>	#       # ------ Outside a tag
214	>	#       else {
215	>	#          if ( $char eq "<") { $self->_opentag() }
216	>	#          else { $self->_putstore($char) }
217	>	#       }
218	>	# }
219	>
220	>
221	>	# #
222	>	# # Return the next character from the current string buffer
223	>	# #
224	>	# sub _nextchar() {
225	>	#       my $self=shift;
226	>	#       my $char;
227	>	#       $char=substr($self->{currentline},$self->{stringpos}++,1);
228	>
229	>	#       # Keep a record for any stream processes
230	>	#       $self->{streamstore}=$self->{streamstore}.$char;
231	>
232	>	#       return $char;
233	>	# }
234	>
235	>	# sub _opentag {
236	>	#       my $self=shift;
237	>	#       my $char;
238	>
239	>	#       # Keep a record of where the tag started
240	>	#       $self->{tagstart}=$self->line();
241	>
242	>	#       # Close the last text segment
243	>	#       $self->{streamtmp}=$self->_popstream();
244	>	#       $self->_calltag($self->{textcontext}, $self->{textcontext},
245	>	#                                                       $self->_getstore());
246	>	#       $self->_resetstore();
247	>	#       $self->_resetlabels();
248	>
249	>	#       # Do we have an opening or closing tag?
250	>	#       if ( ($char=$self->_nextchar()) eq "/" ) { #we have a closing tag
251	>	#         $self->{tagbuff}="<".$char;
252	>	#         $self->{tagcontext}="endtag";
253	>	#       }
254	>	#       else { # an opening tag
255	>	#         $self->{tagbuff}="<";
256	>	#         $self->{tagcontext}="starttag";
257	>	#         $self->_checkchar($char);
258	>	#       }
259	>	# }
260	>
261	>	# #
262	>	# # Close a tag
263	>	# #
264	>	# sub _closetag {
265	>	#       my $self=shift;
266	>	#       my $tagroutine;
267
268	<	#
269	<	# Close a tag
270	<	#
271	<	sub _closetag {
272	<	my $self=shift;
273	<	my $tagroutine;
268	>	#       # -- Finish off any labels/get tagname
269	>	#       $self->_closelabel();
270	>
271	>	#       # -- Call the associated tag function if appropriate
272	>	#       if ( defined $self->{tagname} ) {
273	>	#        $tagroutine=$self->{tagname}."_".$self->{tagcontext};
274	>	#        $self->_calltag($tagroutine, $self->{tagname},
275	>	#                                                       $self->{tagvar});
276	>
277	>	#        # -- Now make sure the text context is set for calling routines to
278	>	#        # -- deal with text portions outside of tags
279	>	#        if ( ($self->{tagcontext} eq "starttag") ) {
280	>	#          if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
281	>	#             push @{$self->{textstack}} , $self->{textcontext};
282	>	#             $self->{textcontext}=$self->{tagname};
283	>	#          }
284	>	#        }
285	>	#        else {
286	>	#         if ( $#{$self->{textstack}} > -1 ) {
287	>	#          if ( $self->{textcontext} eq $self->{tagname} ) {
288	>	#           if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
289	>	#             # -- watch out for valid tags we ignore in this parse
290	>	#             $self->{textcontext}=pop @{$self->{textstack}};
291	>	#           }
292	>	#          }
293	>	#           else { #The tag we are closing is not the last one so
294	>	#                  # we keep our current context.
295	>	#              $self->_removefromstack($self->{tagname},$self->{textstack});
296	>	#           }
297	>
298	>	#         }
299	>	#         else { # more close tags than open ones
300	>	#           if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
301	>	#            print "Warning : Unmatched </...> tag on line ".
302	>	#                                       $self->line()."\n";
303	>	#           }
304	>	#         }
305	>	#        }
306	>	#       }
307	>	#       # Reset context back to text
308	>	#       $self->{tagcontext}="text";
309	>	# }
310	>
311	>	# sub _calltag {
312	>	#       my $self=shift;
313	>	#       my $tagroutine=shift;
314	>	#       my @args=@_;
315	>	#       my $rt;
316	>	#       my $found=0;
317
318	<	# -- Finish off any labels/get tagname
201	<	$self->_closelabel();
318	>	# #     print "TAGROUTINE: ",$tagroutine,"\n";
319
320	<	# -- Call the associated tag function if appropriate
321	<	$tagroutine=$self->{tagname}."_".$self->{tagcontext};
322	<	$self->_calltag($tagroutine, $self->{tagname},
323	<	$self->{tagvar});
324	<	#print "\nDebug : Closing Tag $tagroutine\n";
325	<
326	<	# -- Now make sure the text context is set for calling routines to
327	<	# -- deal with text portions outside of tags
328	<	if ( $self->{tagcontext} eq "starttag" ) {
329	<	push @{$self->{textstack}} , $self->{textcontext};
330	<	$self->{textcontext}=$self->{tagname};
331	<	}
332	<	else {
216	<	if ( $#{$self->{textstack}} > -1 ) {
217	<	if ( $self->{textcontext} eq $self->{tagname} ) {
218	<	$self->{textcontext}=pop @{$self->{textstack}};
219	<	}
220	<	else { #The tag we are closing is not the last one so
221	<	# we keep our current context.
222	<	$self->_removefromstack($self->{tagname},$self->{textstack});
223	<	}
224	<
225	<	}
226	<	else { # more close tags than open ones
227	<	print "Warning : Unmatched </...> tag on line ".
228	<	$self->line()."\n";
229	<	}
230	<	}
231	<	# Reset context back to text
232	<	$self->{tagcontext}="text";
233	<	}
234	<
235	<	sub _calltag {
236	<	my $self=shift;
237	<	my $tagroutine=shift;
238	<	my @args=@_;
239	<	my $rt;
240	<	my $found=0;
241	<
242	<	if ( $self->{groupchecker}->status() ||
243	<	( $self->{tagcontainer}->inquiregroup($tagroutine)) ) {
244	<	($rt,$obj)=$self->{tagcontainer}->getroutine($tagroutine);
245	<	if ( $rt ne "" ) {
246	<	if ( ! defined $obj ) {
247	<	&{$rt}( $self->{allw},@_);
248	<	}
249	<	else {
250	<	&{$rt}( $obj,@_);
251	<	}
252	<	$found=1;
253	<	}
254	<	}
320	>	#       if ( $self->{groupchecker}->status() ||
321	>	#               ( $self->{tagcontainer}->inquiregroup($tagroutine)) ) {
322	>	#         ($rt,$obj)=$self->{tagcontainer}->getroutine($tagroutine);
323	>	#         if ( $rt ne "" ) {
324	>	#            if ( ! defined $obj ) {
325	>	#              &{$rt}( $self->{allw},@_);
326	>	#            }
327	>	#            else {
328	>	#              &{$rt}( $obj,@_);
329	>	#            }
330	>	#            $found=1;
331	>	#         }
332	>	#       }
333
334	<	# stream function
335	<	if ( ! exists $self->{streamexclude}{$tagroutine} ) {
336	<	$self->_printstream();
337	<	}
338	<	$self->_clearstream();
339	<	}
340	<
341	<	sub _clearstream {
342	<	my $self=shift;
343	<	$self->{streamstore}=(($self->{streamtmp} ne "")?$self->{streamtmp}:"");
344	<	$self->{streamtmp}="";
345	<	}
346	<
347	<	sub _popstream {
348	<	my $self=shift;
349	<	$self->{streamstore}=~s/(.*)(.)$/$1/;
350	<	return $2;
351	<	}
352	<
353	<	sub _printstream {
354	<
355	<	my $self=shift;
356	<
357	<	# Stream output functionality
358	<	if ( defined $self->{stream} ) {
359	<	print {$self->{stream}} "$self->{streamstore}";
360	<	}
361	<	}
362	<
363	<	sub _removefromstack {
364	<	my $self=shift;
365	<	my $name=shift;
366	<	my $stack=shift;
367	<	my $this;
368	<
369	<	undef @tempstack;
370	<	#print "In  ----".$#{$stack};
371	<	# Keep popping until we find our string
372	<	while ( ($this=(pop @{$stack})) ne "$name") {
373	<	push @tempstack, $this;
374	<	if ( $#{$stack} < 0 ) { last; }
375	<	}
376	<	# Now put them back
377	<	while ( $#tempstack>-1) {
378	<	$this=pop @tempstack;
379	<	push @{$stack}, $this;
380	<	}
381	<	#print " Out ----".$#{$stack};
382	<	}
334	>	#       # stream function
335	>	#         if ( ! exists $self->{streamexclude}{$tagroutine} ) {
336	>	#           $self->_printstream();
337	>	#       }
338	>	#       $self->_clearstream();
339	>	# }
340	>
341	>	# sub _clearstream {
342	>	#       my $self=shift;
343	>	#       $self->{streamstore}=(($self->{streamtmp} ne "")?$self->{streamtmp}:"");
344	>	#       $self->{streamtmp}="";
345	>	# }
346	>
347	>	# sub _popstream {
348	>	#       my $self=shift;
349	>	#       $self->{streamstore}=~s/(.*)(.)$/$1/;
350	>	#       return $2;
351	>	# }
352	>
353	>	# sub _printstream {
354	>
355	>	#       my $self=shift;
356	>
357	>	#       # Stream output functionality
358	>	#         if ( defined $self->{stream} ) {
359	>	#             print {$self->{stream}} "$self->{streamstore}";
360	>	#         }
361	>	# }
362	>
363	>	# sub _removefromstack {
364	>	#       my $self=shift;
365	>	#       my $name=shift;
366	>	#       my $stack=shift;
367	>	#       my $this;
368	>
369	>	#       undef @tempstack;
370	>	#       # Keep popping until we find our string
371	>	#       while ( ($this=(pop @{$stack})) ne "$name") {
372	>	#         push @tempstack, $this;
373	>	#         if ( $#{$stack} < 0 ) { last; }
374	>	#       }
375	>	#       # Now put them back
376	>	#       while ( $#tempstack>-1) {
377	>	#         $this=pop @tempstack;
378	>	#         push @{$stack}, $this;
379	>	#       }
380	>	# }
381	>
382	>	# #
383	>	# # Quote handling
384	>	# #
385	>
386	>	# sub _quotetest {
387	>	#       my $self=shift;
388	>	#       my $char=shift;
389	>
390	>	#       # --- Are we already in a quote context?
391	>	#       if ( $self->{quotes} ) {
392	>	#          if ( $char eq $self->{openquote} ) {
393	>	#            $self->{quotes}=0;
394	>	#          }
395	>	#        else {
396	>	#          $self->_putstore($char);
397	>	#        }
398	>	#         }
399	>	#       # --- Unquoted Context
400	>	#       elsif ( (($char eq "\"") || ($char eq "\'") || ($char eq "\`")) ) {
401	>	#          $self->{quotes}=1;
402	>	#            $self->{openquote}=$char;
403	>	#       }
404	>	#       else { return 0; } # Return zero if not quoted
405	>	#       return 1;          # 1 otherwise
406	>	# }
407	>
408	>	# #
409	>	# # Label handling
410	>	# #
411	>	# sub _labeltest {
412	>	#       my $self=shift;
413	>	#         my $char=shift;
414	>
415	>	#       # Spaces are markers between tags
416	>	#       if ( ($char eq " ") || ($char eq "\n") || ($char eq "\t")) {
417	>	#         $self->_closelabel();
418	>	#       }
419	>	#       # Check for a change in label status
420	>	#       elsif ( $char eq "=" ) {
421	>	#                 $self->{lastlabel}=$self->_getstore();
422	>	#               $self->_resetstore();
423	>	#         }
424	>	#       else {
425	>	#            return 0;
426	>	#       }
427	>	#       return 1;
428	>	# }
429	>
430	>	# sub _resetlabels {
431	>	#       my $self=shift;
432	>	#       undef $self->{tagvar};
433	>	#       undef $self->{tagname};
434	>	# }
435	>
436	>	# sub _closelabel {
437	>	#       my $self=shift;
438	>
439	>	#       # Do we have a label name?
440	>	#       if ( $self->{lastlabel} ne "" ) {
441	>	#        (my $label=$self->{lastlabel})=~tr[A-Z][a-z];
442	>	#        $self->{tagvar}{$label}=$self->_getstore();
443	>	#        $self->{lastlabel}="";
444	>	#       }
445	>	#       elsif ( $self->_getstore() ne "") {
446	>	#          # Then it must be the tag name
447	>	#        if ( ! defined $self->{tagname} ) {
448	>	#           ($self->{tagname}=$self->_getstore())=~tr/A-Z/a-z/;
449	>	#        }
450	>	#        else {
451	>	#           # -- assume that this is plain text
452	>	#           $self->{tagcontext}="text";
453	>	#           $self->_resetstore();
454	>	#           $self->_unshiftstore($self->{tagbuff});
455	>	#           $self->{tagbuff}="";
456	>	#           return;
457	>	#        }
458	>	#       }
459	>	#       $self->_resetstore();
460	>	# }
461	>
462	>	# #
463	>	# # Character Store management interface
464	>	# #
465	>	# sub _putstore() {
466	>	#       my $self=shift;
467	>	#       my $char=shift;
468	>
469	>	#       $self->{stringbuff}=$self->{stringbuff}.$char;
470	>	# }
471	>
472	>	# sub _unshiftstore() {
473	>	#       my $self=shift;
474	>	#       my $char=shift;
475	>
476	>	#       $self->{stringbuff}=$char.$self->{stringbuff};
477	>	# }
478	>
479	>	# sub _getstore() {
480	>	#       my $self=shift;
481	>
482	>	#       return $self->{stringbuff};
483	>	# }
484	>
485	>	# sub _resetstore {
486	>	#       my $self=shift;
487	>	#       $self->{stringbuff}="";
488	>	# }
489
490	<	#
307	<	# Quote handling
308	<	#
309	<
310	<	sub _quotetest {
311	<	my $self=shift;
312	<	my $char=shift;
313	<
314	<	# --- Are we already in a quote context?
315	<	if ( $self->{quotes} ) {
316	<	if ( $char eq $self->{openquote} ) {
317	<	$self->{quotes}=0;
318	<	}
319	<	else {
320	<	$self->_putstore($char);
321	<	}
322	<	}
323	<	# --- Unquoted Context
324	<	elsif ( (($char eq "\"") || ($char eq "\'") || ($char eq "\`")) ) {
325	<	$self->{quotes}=1;
326	<	$self->{openquote}=$char;
327	<	}
328	<	else { return 0; } # Return zero if not quoted
329	<	return 1;          # 1 otherwise
330	<	}
331	<
332	<	#
333	<	# Label handling
334	<	#
335	<	sub _labeltest {
336	<	my $self=shift;
337	<	my $char=shift;
338	<
339	<	# Spaces are markers between tags
340	<	if ( ($char eq " ") || ($char eq "\n") || ($char eq "\t")) {
341	<	$self->_closelabel();
342	<	}
343	<	# Check for a change in label status
344	<	elsif ( $char eq "=" ) {
345	<	$self->{lastlabel}=$self->_getstore();
346	<	$self->_resetstore();
347	<	}
348	<	else {
349	<	return 0;
350	<	}
351	<	return 1;
352	<	}
353	<
354	<	sub _resetlabels {
355	<	my $self=shift;
356	<	undef $self->{tagvar};
357	<	}
358	<
359	<	sub _closelabel {
360	<	my $self=shift;
361	<
362	<	# Do we have a label name?
363	<	if ( $self->{lastlabel} ne "" ) {
364	<	$self->{tagvar}{$self->{lastlabel}}=$self->_getstore();
365	<	$self->{lastlabel}="";
366	<	}
367	<	elsif ( $self->_getstore() ne "") {
368	<	#Then it must be the tag name
369	<	($self->{tagname}=$self->_getstore())=~tr/A-Z/a-z/;
370	<	}
371	<	$self->_resetstore();
372	<	}
373	<
374	<	#
375	<	# Character Store management interface
376	<	#
377	<	sub _putstore() {
378	<	my $self=shift;
379	<	my $char=shift;
380	<
381	<	$self->{stringbuff}=$self->{stringbuff}.$char;
382	<	}
383	<
384	<	sub _getstore() {
385	<	my $self=shift;
386	<
387	<	return $self->{stringbuff};
388	<	}
389	<
390	<	sub _resetstore {
391	<	my $self=shift;
392	<	$self->{stringbuff}="";
393	<	}
490	>	1;

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines