| 6 |
|
# processed. |
| 7 |
|
# Interface |
| 8 |
|
# --------- |
| 9 |
< |
# new(hash,file,objectref,[groupchecker]) : A new object requires a hash of |
| 10 |
< |
# labels->routine references |
| 11 |
< |
# filename of pfile to parse |
| 12 |
< |
# objectref->of the methods associated# with the labels |
| 13 |
< |
# groupchecker for control of calling |
| 14 |
< |
# tag groups (on/off) |
| 15 |
< |
# parse() : Parse the file |
| 9 |
> |
# new(file,objectref) : A new object - filename of file to parse |
| 10 |
> |
# objectref->of the methods |
| 11 |
> |
# usetags(tagobjref) : Specify a tagcontainer set to direct to |
| 12 |
> |
# to the desired routines |
| 13 |
> |
# usegroupchecker(groupchecker) : Set a groupchecker |
| 14 |
> |
# parse() : Parse the file |
| 15 |
|
# checkparam($name,$par) : Exit with an error message if parameter |
| 16 |
|
# is undefined in tag $name |
| 17 |
|
# line() : return the current line number of the parse |
| 22 |
|
|
| 23 |
|
sub new { |
| 24 |
|
my $class=shift; |
| 26 |
– |
my $hash=shift; |
| 25 |
|
my $file=shift; |
| 26 |
|
my $objectname=shift; |
| 27 |
|
my $groupchecker=shift; |
| 29 |
|
my $self = {}; |
| 30 |
|
$self->{allw}=$objectname; |
| 31 |
|
bless $self, $class; |
| 32 |
< |
$self->_initialise($hash,$file,$groupchecker); |
| 35 |
< |
$self->_resetvars(); |
| 32 |
> |
$self->_initialise($file); |
| 33 |
|
return $self; |
| 34 |
|
} |
| 35 |
|
|
| 36 |
|
sub _initialise (hash1) { |
| 37 |
|
my $self=shift; |
| 41 |
– |
my $inlabelhash=shift; |
| 38 |
|
$self->{filename}=shift; |
| 43 |
– |
my $groupchecker=shift; |
| 39 |
|
|
| 40 |
< |
my $newkey; |
| 46 |
< |
my $key; |
| 47 |
< |
$self->{labelhash}={}; |
| 48 |
< |
$self->{Strict_no_cr}='yes'; # set to 'no' to retain \n's |
| 49 |
< |
|
| 50 |
< |
# Fill in the blanks in the user supplied hash |
| 51 |
< |
if ( ! ( defined $$inlabelhash{'none'} )) { # check for none target |
| 52 |
< |
$$inlabelhash{'none'}='none'; |
| 53 |
< |
} |
| 54 |
< |
block1: foreach $key ( keys %$inlabelhash ) { |
| 55 |
< |
($newkey=$key)=~tr[A-Z][a-z]; |
| 56 |
< |
${$self->{labelhash}}{$newkey}=$$inlabelhash{$key}; |
| 57 |
< |
foreach $context ( values %{$self->{opencontext}} ) { |
| 58 |
< |
next block1 if $newkey=~/$context/i; |
| 59 |
< |
} |
| 60 |
< |
foreach $context ( values %{$self->{opencontext}} ) { |
| 61 |
< |
if ( defined ${$self->{labelhash}}{$newkey."_".$context} ) { |
| 62 |
< |
next block1; |
| 63 |
< |
} |
| 64 |
< |
# print "Setting ".$newkey."_".$context." = 'none'\n"; |
| 65 |
< |
${$self->{labelhash}}{$newkey."_".$context}='none'; |
| 66 |
< |
} |
| 67 |
< |
} |
| 68 |
< |
|
| 69 |
< |
|
| 70 |
< |
foreach $key ( %$self->{labelhash} ) { |
| 71 |
< |
${$self->{ContextHash}}{$key} = 0; |
| 72 |
< |
} |
| 73 |
< |
$self->{InTag}="none"; |
| 74 |
< |
$taglabel=""; |
| 75 |
< |
$self->{tagblock}=[]; |
| 76 |
< |
@{$self->{lastcon}}= qw(none); |
| 77 |
< |
|
| 78 |
< |
# Add a groupchecker |
| 79 |
< |
if ( $groupchecker eq "" ) { |
| 40 |
> |
# add a default groupchecker |
| 41 |
|
use Utilities::GroupChecker; |
| 42 |
|
$self->{groupchecker}=GroupChecker->new(); |
| 43 |
|
$self->{groupchecker}->include("all"); |
| 44 |
< |
} |
| 45 |
< |
else { |
| 46 |
< |
$self->{groupchecker}=$groupchecker; |
| 47 |
< |
} |
| 44 |
> |
|
| 45 |
> |
# Add a default tagcontainer |
| 46 |
> |
use Utilities::tagcontainer; |
| 47 |
> |
$self->{tagcontainer}=tagcontainer->new(); |
| 48 |
> |
|
| 49 |
> |
} |
| 50 |
> |
|
| 51 |
> |
sub usetags { |
| 52 |
> |
my $self=shift; |
| 53 |
> |
my $tagcontainer=shift; |
| 54 |
> |
|
| 55 |
> |
$self->{tagcontainer}=$tagcontainer; |
| 56 |
|
} |
| 57 |
|
|
| 58 |
+ |
sub usegroupchecker { |
| 59 |
+ |
my $self=shift; |
| 60 |
+ |
my $ref=shift; |
| 61 |
+ |
|
| 62 |
+ |
$self->{groupchecker}=$shift; |
| 63 |
+ |
} |
| 64 |
|
|
| 65 |
|
sub parse { |
| 66 |
|
my $self=shift; |
| 67 |
|
my $char; |
| 68 |
|
$self->{linecount}=0; |
| 69 |
+ |
$self->_resetvars(); |
| 70 |
|
|
| 71 |
|
# Open the file |
| 72 |
|
use FileHandle; |
| 222 |
|
my $self=shift; |
| 223 |
|
my $tagroutine=shift; |
| 224 |
|
my @args=@_; |
| 225 |
+ |
my $rt; |
| 226 |
|
|
| 227 |
|
if ( $self->{groupchecker}->status() ) { |
| 228 |
< |
if ( ( exists $self->{labelhash}{$tagroutine}) && |
| 229 |
< |
( $self->{labelhash}{$tagroutine}!~/none/i ) |
| 230 |
< |
) { |
| 231 |
< |
&{ ${$self->{labelhash}}{$tagroutine}} ( |
| 255 |
< |
$self->{allw},@_); |
| 256 |
< |
} |
| 228 |
> |
$rt=$self->{tagcontainer}->getroutine($tagroutine); |
| 229 |
> |
if ( $rt ne "" ) { |
| 230 |
> |
&{$rt}( $self->{allw},@_); |
| 231 |
> |
} |
| 232 |
|
} |
| 233 |
|
} |
| 234 |
|
|
