src/ActiveDoc/Switcher.pm

# Switcher Module
#
# Look for elements given in input has in a string
# If found then call a routine name with the same name
# Implemented as an object to maintain state info between each line
# processed.
# Interface
# ---------
#
# new(file,objectref) : A new object -  filename of file to parse
#                                       objectref->of the methods
# usetags(tagobjref)               : Specify a tagcontainer set to direct to
#                                    to the desired routines
# usegroupchecker(groupchecker)    : Set a groupchecker
# parse()                          : Parse the file                             
# line()                           : return the current line number of the parse
# tagstartline()                   : return the line number on which the current
#                                    tag was opened
# stream(filehandle)               : stream output to the filehandle if not handled
#                                    in any other way
package ActiveDoc::Switcher;
use Utilities::Verbose;
require 5.001;
use Carp;

@ISA=qw(Utilities::Verbose);

sub new { 
        my $class=shift;
        my $file=shift;
        my $objectname=shift;
        my $groupchecker=shift;

        $self = {};
        $self->{allw}=$objectname;
        bless $self, $class;
        $self->_initialise($file);
        return $self;
}

sub stream {
        my $self=shift;

        $self->{stream}=shift;
}

sub streamexclude {
        my $self=shift;
        my $tag=shift;

        $tag=~tr/A-Z/a-z/;
        $self->{streamexclude}{$tag}=1;
}

sub _initialise (hash1)
   {
   my $self=shift;
   $self->{filename}=shift;
   $self->verbose(">> New ActiveDoc::Switcher created.");
   # add a default groupchecker
   use ActiveDoc::GroupChecker;
   $self->{groupchecker}=GroupChecker->new();
   $self->{groupchecker}->include("all");

   # Add a default TagContainer
   use ActiveDoc::TagContainer;
   $self->{tagcontainer}=ActiveDoc::TagContainer->new();
   
   }

sub usetags {
        my $self=shift;
        my $tagcontainer=shift;

        $self->{tagcontainer}=$tagcontainer;
}

sub usegroupchecker {
        my $self=shift;
        my $ref=shift;
        
        $self->{groupchecker}=$ref;
}

sub parse {
        my $self=shift;
        my $char;
        my $buf;
        $self->{linecount}=0;
        $self->_resetvars();
        $self->{streamstore}="";
        $self->{streamtmp}="";

        # Open the file
        use FileHandle;
        local $filehandle;
        $filehandle=FileHandle->new();
        
        $self->verbose(">> Reading file: ".$self->{filename}." ");

        $filehandle->open("<".$self->{filename})
           or return 1;

        # Start file processing
        while ( ($_=<$filehandle>) ) {
         $self->{linecount}++;
         # Skip lines that start with a hash. A better way
         # of adding comments than ignore tags:
         next if (/^#/);
         $self->{currentline}=$_;
         $self->{stringpos}=0;
         while ( ($char=$self->_nextchar()) ne "" ) {
           $self->_checkchar($char);
         } # end char while
        } # End String while loop
        undef $filehandle;
        # make sure we close the last buffer
        $self->_calltag($self->{textcontext}, $self->{textcontext},
                                                        $self->_getstore());
}
        
sub parsefilelist
   {
   my $self=shift;
   my ($char,$buf);
   
   $self->{linecount}=0;
   $self->_resetvars();
   $self->{streamstore}="";
   $self->{streamtmp}="";
   
   foreach my $buildfile (@{$self->{filename}})
      {
      if ( -f $buildfile)
         {
         # Open the file
         use FileHandle;
         local $filehandle;
         $filehandle=FileHandle->new();
         $self->verbose(">> Reading file: ".$buildfile." ");
         $filehandle->open("<".$buildfile) or return 1;
         
         # Start file processing
         while ( ($_=<$filehandle>) )
            {
            $self->{linecount}++;
            # Skip lines that start with a hash. A better way
            # of adding comments than ignore tags:
            next if (/^#/);
            $self->{currentline}=$_;
            $self->{stringpos}=0;
            while ( ($char=$self->_nextchar()) ne "" )
               {
               $self->_checkchar($char);
               } # end char while
            } # End String while loop
         undef $filehandle;
         # Make sure we close the last buffer:
         $self->_calltag($self->{textcontext}, $self->{textcontext},
                         $self->_getstore());
         }
      }
   }

#
# return the current line number
#
sub line {
        my $self=shift;
        return $self->{linecount};
}

# return the line the current tag was opened
sub tagstartline {
        my $self=shift;
        $self->{tagstart};
}
# --------------- Utility routines ----------------------------
 
#
# Some initialisation of test suites
#
sub _resetvars {
        my $self=shift;
        $self->{quotes}=0;
        $self->{lastlabel}="";
        $self->{textcontext}='none';
        $self->{tagcontext}="text";
        $self->_resetstore();
}

#
# Check for control characters
#
sub _checkchar {
        my $self=shift;
        my $char=shift;
        my $string;


        # ---- In a tag
        if ( $self->{tagcontext}=~/tag/ ) {
           $self->{tagbuff}=$self->{tagbuff}.$char;
           if ( ! $self->_quotetest($char) ) {
            if ( ! $self->_labeltest($char) ) {
             if ( $char eq ">") { $self->_closetag(); }
             else { $self->_putstore($char); }
            }
           }  
        }
        # ------ Outside a tag
        else { 
           if ( $char eq "<") { $self->_opentag() }
           else { $self->_putstore($char) } 
        }
}


#
# Return the next character from the current string buffer
#
sub _nextchar() {
        my $self=shift;
        my $char;
        $char=substr($self->{currentline},$self->{stringpos}++,1);

        # Keep a record for any stream processes
        $self->{streamstore}=$self->{streamstore}.$char;

        return $char;
}

sub _opentag {
        my $self=shift;
        my $char;

        # Keep a record of where the tag started
        $self->{tagstart}=$self->line();

        # Close the last text segment
        $self->{streamtmp}=$self->_popstream();
        $self->_calltag($self->{textcontext}, $self->{textcontext}, 
                                                        $self->_getstore());
        $self->_resetstore();
        $self->_resetlabels();

        # Do we have an opening or closing tag?
        if ( ($char=$self->_nextchar()) eq "/" ) { #we have a closing tag
          $self->{tagbuff}="<".$char;
          $self->{tagcontext}="endtag";
        }
        else { # an opening tag
          $self->{tagbuff}="<";
          $self->{tagcontext}="starttag";
          $self->_checkchar($char);
        }
}

#
# Close a tag
#
sub _closetag {
        my $self=shift;
        my $tagroutine;

        # -- Finish off any labels/get tagname
        $self->_closelabel();
        
        # -- Call the associated tag function if appropriate
        if ( defined $self->{tagname} ) {
         $tagroutine=$self->{tagname}."_".$self->{tagcontext};
         $self->_calltag($tagroutine, $self->{tagname}, 
                                                        $self->{tagvar});

         # -- Now make sure the text context is set for calling routines to
         # -- deal with text portions outside of tags
         if ( ($self->{tagcontext} eq "starttag") ) {
           if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
              push @{$self->{textstack}} , $self->{textcontext};
              $self->{textcontext}=$self->{tagname};
           }
         }
         else {
          if ( $#{$self->{textstack}} > -1 ) {
           if ( $self->{textcontext} eq $self->{tagname} ) {    
            if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
              # -- watch out for valid tags we ignore in this parse
              $self->{textcontext}=pop @{$self->{textstack}};
            }
           } 
            else { #The tag we are closing is not the last one so
                   # we keep our current context.
               $self->_removefromstack($self->{tagname},$self->{textstack});
            }

          }
          else { # more close tags than open ones
            if ( $self->{tagcontainer}->definescontext($self->{tagname}) ) {
             print "Warning : Unmatched </...> tag on line ".
                                        $self->line()."\n";     
            }
          }
         }
        }
        # Reset context back to text
        $self->{tagcontext}="text";
}

sub _calltag {
        my $self=shift;
        my $tagroutine=shift;
        my @args=@_;
        my $rt;
        my $found=0;

#       print "TAGROUTINE: ",$tagroutine,"\n";
        
        if ( $self->{groupchecker}->status() ||
                ( $self->{tagcontainer}->inquiregroup($tagroutine)) ) {
          ($rt,$obj)=$self->{tagcontainer}->getroutine($tagroutine);
          if ( $rt ne "" ) {
             if ( ! defined $obj ) {
               &{$rt}( $self->{allw},@_);
             }
             else {
               &{$rt}( $obj,@_);
             }
             $found=1;
          }
        }
        
        # stream function
        if ( ! exists $self->{streamexclude}{$tagroutine} ) {
            $self->_printstream();
        }
        $self->_clearstream();
}

sub _clearstream {
        my $self=shift;
        $self->{streamstore}=(($self->{streamtmp} ne "")?$self->{streamtmp}:"");
        $self->{streamtmp}="";
}

sub _popstream {
        my $self=shift;
        $self->{streamstore}=~s/(.*)(.)$/$1/;
        return $2;
}

sub _printstream {

        my $self=shift;

        # Stream output functionality
        if ( defined $self->{stream} ) {
            print {$self->{stream}} "$self->{streamstore}";
        }
}

sub _removefromstack {
        my $self=shift;
        my $name=shift;
        my $stack=shift;
        my $this;

        undef @tempstack;
        # Keep popping until we find our string
        while ( ($this=(pop @{$stack})) ne "$name") {
          push @tempstack, $this; 
          if ( $#{$stack} < 0 ) { last; }
        }
        # Now put them back
        while ( $#tempstack>-1) {
          $this=pop @tempstack;
          push @{$stack}, $this;
        }
}

#
# Quote handling
#

sub _quotetest {
        my $self=shift;
        my $char=shift;

        # --- Are we already in a quote context?
        if ( $self->{quotes} ) {
         if ( $char eq $self->{openquote} ) {
           $self->{quotes}=0;
         }
         else {
           $self->_putstore($char);
         }
        }
        # --- Unquoted Context
        elsif ( (($char eq "\"") || ($char eq "\'") || ($char eq "\`")) ) {
           $self->{quotes}=1;
           $self->{openquote}=$char;
        }
        else { return 0; } # Return zero if not quoted
        return 1;          # 1 otherwise
}

#
# Label handling
#
sub _labeltest {
        my $self=shift;
        my $char=shift;

        # Spaces are markers between tags
        if ( ($char eq " ") || ($char eq "\n") || ($char eq "\t")) {
          $self->_closelabel();
        }
        # Check for a change in label status
        elsif ( $char eq "=" ) {
                $self->{lastlabel}=$self->_getstore();
                $self->_resetstore();
        }
        else {
             return 0;
        }
        return 1;
}

sub _resetlabels {
        my $self=shift;
        undef $self->{tagvar};
        undef $self->{tagname};
}

sub _closelabel {
        my $self=shift;

        # Do we have a label name?
        if ( $self->{lastlabel} ne "" ) {
         (my $label=$self->{lastlabel})=~tr[A-Z][a-z];
         $self->{tagvar}{$label}=$self->_getstore();
         $self->{lastlabel}="";
        }
        elsif ( $self->_getstore() ne "") { 
         # Then it must be the tag name
         if ( ! defined $self->{tagname} ) {
            ($self->{tagname}=$self->_getstore())=~tr/A-Z/a-z/;
         }
         else {
            # do not die anymore - breaks non tag documents
            #die ">Tag syntax error in $self->{tagname} on line ".
            #   $self->line()." of file \n$self->{filename}";
            # -- assume that this is plain text
            $self->{tagcontext}="text";
            $self->_resetstore();
            $self->_unshiftstore($self->{tagbuff});
            $self->{tagbuff}="";
            return;
         }
        }
        $self->_resetstore();
}

#
# Character Store management interface
#
sub _putstore() {
        my $self=shift;
        my $char=shift;

        $self->{stringbuff}=$self->{stringbuff}.$char;
}

sub _unshiftstore() {
        my $self=shift;
        my $char=shift;

        $self->{stringbuff}=$char.$self->{stringbuff};
}

sub _getstore() {
        my $self=shift;

        return $self->{stringbuff};
}

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