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.16 by williamc, Tue Nov 14 15:20:55 2000 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	<	# 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
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 {
25	<	my $class=shift;
26	<	my $file=shift;
27	<	my $objectname=shift;
28	<	my $groupchecker=shift;
29	<
30	<	$self = {};
31	<	$self->{allw}=$objectname;
32	<	bless $self, $class;
33	<	$self->_initialise($file);
34	<	return $self;
35	<	}
36	<
37	<	sub stream {
38	<	my $self=shift;
39	<
40	<	$self->{stream}=shift;
41	<	}
42	<
43	<	sub streamexclude {
44	<	my $self=shift;
45	<	my $tag=shift;
46	<
47	<	$tag=~tr/A-Z/a-z/;
48	<	$self->{streamexclude}{$tag}=1;
49	<	}
50	<
51	<	sub _initialise (hash1) {
52	<	my $self=shift;
53	<	$self->{filename}=shift;
54	<
55	<	# add a default groupchecker
56	<	use ActiveDoc::GroupChecker;
57	<	$self->{groupchecker}=GroupChecker->new();
58	<	$self->{groupchecker}->include("all");
59	<
60	<	# Add a default TagContainer
61	<	use ActiveDoc::TagContainer;
62	<	$self->{tagcontainer}=ActiveDoc::TagContainer->new();
63	<
64	<	}
65	<
66	<	sub usetags {
67	<	my $self=shift;
68	<	my $tagcontainer=shift;
69	<
70	<	$self->{tagcontainer}=$tagcontainer;
71	<	}
72	<
73	<	sub usegroupchecker {
74	<	my $self=shift;
75	<	my $ref=shift;
76	<
77	<	$self->{groupchecker}=$ref;
78	<	}
26	>	BEGIN { print __PACKAGE__." still used.\n"; exit(1) }
27
28	<	sub parse {
81	<	my $self=shift;
82	<	my $char;
83	<	my $buf;
84	<	$self->{linecount}=0;
85	<	$self->_resetvars();
86	<	$self->{streamstore}="";
87	<	$self->{streamtmp}="";
88	<
89	<	# Open the file
90	<	use FileHandle;
91	<	local $filehandle;
92	<	$filehandle=FileHandle->new();
93	<	$filehandle->open("<".$self->{filename})
94	<	or return 1;
95	<	# The buffering seems all messed up - best not to use it
96	<	$filehandle->setvbuf($buf, _IONBF, 3000);
97	<
98	<	# Start file processing
99	<	while ( ($_=<$filehandle>) ) {
100	<	$self->{linecount}++;
101	<	$self->{currentline}=$_;
102	<	$self->{stringpos}=0;
103	<	while ( ($char=$self->_nextchar()) ne "" ) {
104	<	$self->_checkchar($char);
105	<	} # end char while
106	<	} # End String while loop
107	<	undef $filehandle;
108	<	# make sure we close the last buffer
109	<	$self->_calltag($self->{textcontext}, $self->{textcontext},
110	<	$self->_getstore());
111	<	#$self->_printstream();
112	<	}
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	<
38	<	# return the line the current tag was opened
39	<	sub tagstartline {
40	<	my $self=shift;
41	<	$self->{tagstart};
42	<	}
43	<	# --------------- Utility routines ----------------------------
44	<
45	<	#
46	<	# Some initialisation of test suites
47	<	#
48	<	sub _resetvars {
49	<	my $self=shift;
50	<	$self->{quotes}=0;
51	<	$self->{lastlabel}="";
52	<	$self->{textcontext}='none';
53	<	$self->{tagcontext}="text";
54	<	$self->_resetstore();
55	<	}
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	<	$self->{tagbuff}=$self->{tagbuff}.$char;
99	<	if ( ! $self->_quotetest($char) ) {
100	<	if ( ! $self->_labeltest($char) ) {
101	<	if ( $char eq ">") { $self->_closetag(); }
156	<	else { $self->_putstore($char); }
157	<	}
158	<	}
159	<	}
160	<	# ------ Outside a tag
161	<	else {
162	<	if ( $char eq "<") { $self->_opentag() }
163	<	else { $self->_putstore($char) }
164	<	}
165	<	}
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	<	# Keep a record of where the tag started
126	<	$self->{tagstart}=$self->line();
127	<
128	<	# Close the last text segment
129	<	$self->{streamtmp}=$self->_popstream();
130	<	$self->_calltag($self->{textcontext}, $self->{textcontext},
131	<	$self->_getstore());
132	<	$self->_resetstore();
133	<	$self->_resetlabels();
134	<
135	<	# Do we have an opening or closing tag?
136	<	if ( ($char=$self->_nextchar()) eq "/" ) { #we have a closing tag
137	<	$self->{tagbuff}="<".$char;
138	<	$self->{tagcontext}="endtag";
139	<	}
140	<	else { # an opening tag
141	<	$self->{tagbuff}="<";
142	<	$self->{tagcontext}="starttag";
143	<	$self->_checkchar($char);
144	<	}
145	<	#print "\nDebug : Opening $self->{tagcontext}\n";
146	<	}
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
218	<	$self->_closelabel();
318	>	# #     print "TAGROUTINE: ",$tagroutine,"\n";
319
320	<	# -- Call the associated tag function if appropriate
321	<	if ( defined $self->{tagname} ) {
322	<	$tagroutine=$self->{tagname}."_".$self->{tagcontext};
323	<	$self->_calltag($tagroutine, $self->{tagname},
324	<	$self->{tagvar});
325	<	#print "\nDebug : Closing Tag $tagroutine\n";
326	<
327	<	# -- Now make sure the text context is set for calling routines to
328	<	# -- deal with text portions outside of tags
329	<	if ( ($self->{tagcontext} eq "starttag") ) {
330	<	if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
331	<	push @{$self->{textstack}} , $self->{textcontext};
332	<	$self->{textcontext}=$self->{tagname};
233	<	}
234	<	}
235	<	else {
236	<	if ( $#{$self->{textstack}} > -1 ) {
237	<	if ( $self->{textcontext} eq $self->{tagname} ) {
238	<	if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
239	<	# -- watch out for valid tags we ignore in this parse
240	<	$self->{textcontext}=pop @{$self->{textstack}};
241	<	}
242	<	}
243	<	else { #The tag we are closing is not the last one so
244	<	# we keep our current context.
245	<	$self->_removefromstack($self->{tagname},$self->{textstack});
246	<	}
247	<
248	<	}
249	<	else { # more close tags than open ones
250	<	if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
251	<	print "Warning : Unmatched </...> tag on line ".
252	<	$self->line()."\n";
253	<	}
254	<	}
255	<	}
256	<	}
257	<	# Reset context back to text
258	<	$self->{tagcontext}="text";
259	<	}
260	<
261	<	sub _calltag {
262	<	my $self=shift;
263	<	my $tagroutine=shift;
264	<	my @args=@_;
265	<	my $rt;
266	<	my $found=0;
267	<
268	<	if ( $self->{groupchecker}->status() ||
269	<	( $self->{tagcontainer}->inquiregroup($tagroutine)) ) {
270	<	($rt,$obj)=$self->{tagcontainer}->getroutine($tagroutine);
271	<	if ( $rt ne "" ) {
272	<	if ( ! defined $obj ) {
273	<	&{$rt}( $self->{allw},@_);
274	<	}
275	<	else {
276	<	&{$rt}( $obj,@_);
277	<	}
278	<	$found=1;
279	<	}
280	<	}
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	<	#
333	<	# Quote handling
334	<	#
335	<
336	<	sub _quotetest {
337	<	my $self=shift;
338	<	my $char=shift;
339	<
340	<	# --- Are we already in a quote context?
341	<	if ( $self->{quotes} ) {
342	<	if ( $char eq $self->{openquote} ) {
343	<	$self->{quotes}=0;
344	<	}
345	<	else {
346	<	$self->_putstore($char);
347	<	}
348	<	}
349	<	# --- Unquoted Context
350	<	elsif ( (($char eq "\"") || ($char eq "\'") || ($char eq "\`")) ) {
351	<	$self->{quotes}=1;
352	<	$self->{openquote}=$char;
353	<	}
354	<	else { return 0; } # Return zero if not quoted
355	<	return 1;          # 1 otherwise
356	<	}
357	<
358	<	#
359	<	# Label handling
360	<	#
361	<	sub _labeltest {
362	<	my $self=shift;
363	<	my $char=shift;
364	<
365	<	# Spaces are markers between tags
366	<	if ( ($char eq " ") || ($char eq "\n") || ($char eq "\t")) {
367	<	$self->_closelabel();
368	<	}
369	<	# Check for a change in label status
370	<	elsif ( $char eq "=" ) {
371	<	$self->{lastlabel}=$self->_getstore();
372	<	$self->_resetstore();
373	<	}
374	<	else {
375	<	return 0;
376	<	}
377	<	return 1;
378	<	}
379	<
380	<	sub _resetlabels {
381	<	my $self=shift;
382	<	undef $self->{tagvar};
383	<	undef $self->{tagname};
384	<	}
385	<
386	<	sub _closelabel {
387	<	my $self=shift;
388	<
389	<	# Do we have a label name?
390	<	if ( $self->{lastlabel} ne "" ) {
391	<	(my $label=$self->{lastlabel})=~tr[A-Z][a-z];
392	<	$self->{tagvar}{$label}=$self->_getstore();
393	<	$self->{lastlabel}="";
394	<	}
395	<	elsif ( $self->_getstore() ne "") {
396	<	# Then it must be the tag name
397	<	if ( ! defined $self->{tagname} ) {
398	<	($self->{tagname}=$self->_getstore())=~tr/A-Z/a-z/;
399	<	}
400	<	else {
401	<	# do not die anymore - breaks non tag documents
402	<	#die ">Tag syntax error in $self->{tagname} on line ".
403	<	#   $self->line()." of file \n$self->{filename}";
404	<	# -- assume that this is plain text
405	<	$self->{tagcontext}="text";
406	<	$self->_resetstore();
407	<	$self->_unshiftstore($self->{tagbuff});
408	<	$self->{tagbuff}="";
409	<	return;
410	<	}
411	<	}
412	<	$self->_resetstore();
413	<	}
414	<
415	<	#
416	<	# Character Store management interface
417	<	#
418	<	sub _putstore() {
419	<	my $self=shift;
420	<	my $char=shift;
421	<
422	<	$self->{stringbuff}=$self->{stringbuff}.$char;
423	<	}
424	<
425	<	sub _unshiftstore() {
426	<	my $self=shift;
427	<	my $char=shift;
428	<
429	<	$self->{stringbuff}=$char.$self->{stringbuff};
430	<	}
431	<
432	<	sub _getstore() {
433	<	my $self=shift;
434	<
435	<	return $self->{stringbuff};
436	<	}
437	<
438	<	sub _resetstore {
439	<	my $self=shift;
440	<	$self->{stringbuff}="";
441	<	}
490	>	1;

Diff Legend

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