ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/ActiveDoc/Switcher.pm
Revision: 1.22
Committed: Tue Feb 27 13:34:49 2007 UTC (18 years, 2 months ago) by sashby
Content type: text/plain
Branch: MAIN
Changes since 1.21: +444 -442 lines
Log Message:
more minor updates.

File Contents

# 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.21 BEGIN { print __PACKAGE__." still used.\n"; exit(1) }
27    
28 sashby 1.17 @ISA=qw(Utilities::Verbose);
29    
30 sashby 1.22 # 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 sashby 1.17
71 sashby 1.22 # }
72 williamc 1.1
73 sashby 1.22 # 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 williamc 1.1
84 sashby 1.22 # $self->{groupchecker}=$ref;
85     # }
86 williamc 1.1
87 sashby 1.22 # 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 sashby 1.17
101 sashby 1.22 # $self->verbose(">> Reading file: ".$self->{filename}." ");
102 sashby 1.17
103 sashby 1.22 # $filehandle->open("<".$self->{filename})
104     # or return 1;
105 williamc 1.1
106 sashby 1.22 # # 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 sashby 1.20
124 sashby 1.22 # sub parsefilelist
125     # {
126     # my $self=shift;
127     # my ($char,$buf);
128 sashby 1.20
129 sashby 1.22 # $self->{linecount}=0;
130     # $self->_resetvars();
131     # $self->{streamstore}="";
132     # $self->{streamtmp}="";
133 sashby 1.20
134 sashby 1.22 # 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 sashby 1.20
145 sashby 1.22 # # 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 williamc 1.1
182 sashby 1.22 # #
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 williamc 1.1
268 sashby 1.22 # # -- Finish off any labels/get tagname
269     # $self->_closelabel();
270 williamc 1.1
271 sashby 1.22 # # -- 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 williamc 1.1
318 sashby 1.22 # # print "TAGROUTINE: ",$tagroutine,"\n";
319 sashby 1.20
320 sashby 1.22 # 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 williamc 1.6
334 sashby 1.22 # # 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;