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.21 by sashby, Tue Feb 27 13:33:04 2007 UTC vs.
Revision 1.22 by sashby, Tue Feb 27 13:34:49 2007 UTC

#	Line 27 | Line 27 | BEGIN { print __PACKAGE__." still used.\
27
28		@ISA=qw(Utilities::Verbose);
29
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();
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	<	}
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;
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	<	}
84	>	#       $self->{groupchecker}=$ref;
85	>	# }
86
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();
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}." ");
101	>	#       $self->verbose(">> Reading file: ".$self->{filename}." ");
102
103	<	$filehandle->open("<".$self->{filename})
104	<	or return 1;
103	>	#       $filehandle->open("<".$self->{filename})
104	>	#          or return 1;
105
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	<	}
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);
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}="";
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;
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 ----------------------------
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;
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	<	# -- Finish off any labels/get tagname
269	<	$self->_closelabel();
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;
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	<	#       print "TAGROUTINE: ",$tagroutine,"\n";
318	>	# #     print "TAGROUTINE: ",$tagroutine,"\n";
319
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	<	}
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	<	# 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	<	}
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	>	1;

Diff Legend

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