src/BuildSystem/Tool.pm

#
# Tool.pm - Store basic tool properties
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# Stores basic tool features
#
# Interface
# ---------
# new()         : A new FeatureTool object
# name()        : get/set the tools name
# version()     : get set the tool version
# url()         : get set the tool url
# features()    : return a list of features defined (ordered in relation to 
#                       their first definition)
# addfeature(name,@value) : add value(s) to the named feature
# setfeature(name,@value) : set value(s) for the named feature
# getfeature(name) : return a list of elements belonging to the named feature
#                       (with embedded dependencies)
# type(name[,type]) : get/set the type associated with a feature
# addrequirement() : add a requirement at the current parse position
# dependencies()   : return a list of dependency objects
# nonembeddeddependencies()   : return a list of dependency objects that
#                               are not embedded into the parameters
# save(location)   : Save object to given file
# restore(location) : Restore object from specified file

package BuildSystem::Tool;
require 5.004;

sub new {
        my $class=shift;
        my $self={};
        bless $self, $class;
        return $self;
}

sub name {
        my $self=shift;

        @_?$self->{name}=shift
          :$self->{name};
}

sub version {
        my $self=shift;

        @_?$self->{version}=shift
          :$self->{version};
}

sub url {
        my $self=shift;

        @_?$self->{url}=shift
          :$self->{url};
}

sub type {
        my $self=shift;
        my $name=shift;

        if ( @_ ) {
          $self->{featuretypes}{$name}=shift;
        }
        return ((defined $self->{featuretypes}{$name})?
                $self->{featuretypes}{$name}:"");
}

sub addfeature {
        my $self=shift;
        my $name=shift;
        my @value=@_;

        $self->_newfeature($name,@value);
        push @{$self->{features}{$name}}, @value;
}

sub setfeature {
        my $self=shift;
        my $name=shift;
        my @value=@_;

        $self->_newfeature($name,@value);
        @{$self->{features}{$name}}=@value;
}


sub _newfeature {
        my $self=shift;
        my $name=shift;
        my @value=@_;

        # if it dosnt exist , make sure we first mark all the current reqs
        # get inserted beforehand
        if ( ! exists $self->{features}{$name} ) {
         # add feature name to our ordered list
         push @{$self->{'features_ordered'}},$name;
         for ( $i=0; $i<=$#{$self->{reqobjs}}; $i++ ) {
           $self->_recordpos( $name, $i);
         }
        }
}

sub features {
        my $self=shift;

#       return (keys %{$self->{features}});
        return @{$self->{'features_ordered'}};
}

sub getfeature {
        my $self=shift;
        my $name=shift;

        my @rv=();
        my @rep;
        # make sure we insert requirements at the right place
        for ( my $i=-1; $i<=$#{$self->{features}{$name}}; $i++ ) {
         if ( $i>=0 ) {
           push @rv, $self->{features}{$name}[$i];
         }
         my @rep=$self->_testpos($name, $i);
         my $repobj;
         foreach $repobj ( @rep ) {
             push @rv, $repobj->getfeature($name);
         }
        }
        return @rv;
}

sub clearfeature {
        my $self=shift;
        my $name=shift;

        undef @{$self->{features}{$name}};
}

sub addrequirement {
        my $self=shift;
        my $reqobj=shift;

        push @{$self->{reqobjs}}, $reqobj;
        foreach $key ( keys %{$self->{features}} ) {
           $self->_recordpos($key,$#{$self->{reqobjs}});
        }
}

sub dependencies {
        my $self=shift;
        return @{$self->{recobjs}}
}

sub save {
        my $self=shift;
        my $location=shift;

        my $fh=FileHandle->new();
        $fh->open(">".$location) or die "Unable to open $location for output".
                                $!."\n";
        print $fh "_sys:name:".$self->name()."\n";
        print $fh "_sys:version:".$self->version()."\n";
        foreach $f ( $self->features()) {
          foreach $val ( $self->getfeature($f) ) {
           print $fh $self->type($f).":".$f.":".$val."\n";
          }
        }
        undef $fh;
}

sub restore {
        my $self=shift;
        my $location=shift;

        my $fh=FileHandle->new();
        $fh->open("<".$location) or die "Unable to open $location for output".
                                $!."\n";
        my ($tool,$type,$variable,$value);
        while ( <$fh> ) {
          chomp;
          next if /^#/;
          next if /^\s*$/;
          ($type, $variable, $value)=split /:/;
          next if ( $variable=~/\&/ );
          $product=~tr[A-Z][a-z];
          if ( $type eq "_sys" ) {
             if ( can($variable)) {
               $self->$variable($value);
             }
          }
          else {
            $self->addfeature($variable,$value);
          }
        }
        undef $fh;
}

sub _recordpos {
        my $self=shift;
        my $name=shift;
        my $recref=shift;

        push @{$self->{requireposition}{$name}{$#{$self->{features}{$name}}}}
                ,$recref;
}

# return array of objects that correspond to the required position
sub _testpos {
        my $self=shift;
        my $name=shift;
        my $ref=shift;

        my @rv=();
        if ( exists $self->{requireposition}{$name}{$ref} ) {
           foreach $recref ( @{$self->{requireposition}{$name}{$ref}} ) {
             push @rv, $self->{reqobjs}[$recref];
           }
        }
        return @rv;
}


Revision:	1.1.2.2
Committed:	Mon Apr 10 16:41:04 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
Changes since 1.1.2.1:	+62 -0 lines
Log Message:	added store and reestore routines
#	User	Rev	Content
1	williamc	1.1.2.1	#
2			# Tool.pm - Store basic tool properties
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8			# Stores basic tool features
9			#
10			# Interface
11			# ---------
12			# new() : A new FeatureTool object
13			# name() : get/set the tools name
14			# version() : get set the tool version
15			# url() : get set the tool url
16			# features() : return a list of features defined (ordered in relation to
17			# their first definition)
18			# addfeature(name,@value) : add value(s) to the named feature
19			# setfeature(name,@value) : set value(s) for the named feature
20			# getfeature(name) : return a list of elements belonging to the named feature
21	williamc	1.1.2.2	# (with embedded dependencies)
22			# type(name[,type]) : get/set the type associated with a feature
23	williamc	1.1.2.1	# addrequirement() : add a requirement at the current parse position
24			# dependencies() : return a list of dependency objects
25	williamc	1.1.2.2	# nonembeddeddependencies() : return a list of dependency objects that
26			# are not embedded into the parameters
27			# save(location) : Save object to given file
28			# restore(location) : Restore object from specified file
29	williamc	1.1.2.1
30			package BuildSystem::Tool;
31			require 5.004;
32
33			sub new {
34			my $class=shift;
35			my $self={};
36			bless $self, $class;
37			return $self;
38			}
39
40			sub name {
41			my $self=shift;
42
43			@_?$self->{name}=shift
44			:$self->{name};
45			}
46
47			sub version {
48			my $self=shift;
49
50			@_?$self->{version}=shift
51			:$self->{version};
52			}
53
54			sub url {
55			my $self=shift;
56
57			@_?$self->{url}=shift
58			:$self->{url};
59			}
60
61	williamc	1.1.2.2	sub type {
62			my $self=shift;
63			my $name=shift;
64
65			if ( @_ ) {
66			$self->{featuretypes}{$name}=shift;
67			}
68			return ((defined $self->{featuretypes}{$name})?
69			$self->{featuretypes}{$name}:"");
70			}
71	williamc	1.1.2.1
72			sub addfeature {
73			my $self=shift;
74			my $name=shift;
75			my @value=@_;
76
77			$self->_newfeature($name,@value);
78			push @{$self->{features}{$name}}, @value;
79			}
80
81			sub setfeature {
82			my $self=shift;
83			my $name=shift;
84			my @value=@_;
85
86			$self->_newfeature($name,@value);
87			@{$self->{features}{$name}}=@value;
88			}
89
90
91			sub _newfeature {
92			my $self=shift;
93			my $name=shift;
94			my @value=@_;
95
96			# if it dosnt exist , make sure we first mark all the current reqs
97			# get inserted beforehand
98			if ( ! exists $self->{features}{$name} ) {
99			# add feature name to our ordered list
100			push @{$self->{'features_ordered'}},$name;
101			for ( $i=0; $i<=$#{$self->{reqobjs}}; $i++ ) {
102			$self->_recordpos( $name, $i);
103			}
104			}
105			}
106
107			sub features {
108			my $self=shift;
109
110			# return (keys %{$self->{features}});
111			return @{$self->{'features_ordered'}};
112			}
113
114			sub getfeature {
115			my $self=shift;
116			my $name=shift;
117
118			my @rv=();
119			my @rep;
120			# make sure we insert requirements at the right place
121			for ( my $i=-1; $i<=$#{$self->{features}{$name}}; $i++ ) {
122			if ( $i>=0 ) {
123			push @rv, $self->{features}{$name}[$i];
124			}
125			my @rep=$self->_testpos($name, $i);
126			my $repobj;
127			foreach $repobj ( @rep ) {
128			push @rv, $repobj->getfeature($name);
129			}
130			}
131			return @rv;
132			}
133
134			sub clearfeature {
135			my $self=shift;
136			my $name=shift;
137
138			undef @{$self->{features}{$name}};
139			}
140
141			sub addrequirement {
142			my $self=shift;
143			my $reqobj=shift;
144
145			push @{$self->{reqobjs}}, $reqobj;
146			foreach $key ( keys %{$self->{features}} ) {
147			$self->_recordpos($key,$#{$self->{reqobjs}});
148			}
149			}
150
151			sub dependencies {
152			my $self=shift;
153			return @{$self->{recobjs}}
154			}
155
156	williamc	1.1.2.2	sub save {
157			my $self=shift;
158			my $location=shift;
159
160			my $fh=FileHandle->new();
161			$fh->open(">".$location) or die "Unable to open $location for output".
162			$!."\n";
163			print $fh "_sys:name:".$self->name()."\n";
164			print $fh "_sys:version:".$self->version()."\n";
165			foreach $f ( $self->features()) {
166			foreach $val ( $self->getfeature($f) ) {
167			print $fh $self->type($f).":".$f.":".$val."\n";
168			}
169			}
170			undef $fh;
171			}
172
173			sub restore {
174			my $self=shift;
175			my $location=shift;
176
177			my $fh=FileHandle->new();
178			$fh->open("<".$location) or die "Unable to open $location for output".
179			$!."\n";
180			my ($tool,$type,$variable,$value);
181			while ( <$fh> ) {
182			chomp;
183			next if /^#/;
184			next if /^\s*$/;
185			($type, $variable, $value)=split /:/;
186			next if ( $variable=~/\&/ );
187			$product=~tr[A-Z][a-z];
188			if ( $type eq "_sys" ) {
189			if ( can($variable)) {
190			$self->$variable($value);
191			}
192			}
193			else {
194			$self->addfeature($variable,$value);
195			}
196			}
197			undef $fh;
198			}
199
200	williamc	1.1.2.1	sub _recordpos {
201			my $self=shift;
202			my $name=shift;
203			my $recref=shift;
204
205			push @{$self->{requireposition}{$name}{$#{$self->{features}{$name}}}}
206			,$recref;
207			}
208
209			# return array of objects that correspond to the required position
210			sub _testpos {
211			my $self=shift;
212			my $name=shift;
213			my $ref=shift;
214
215			my @rv=();
216			if ( exists $self->{requireposition}{$name}{$ref} ) {
217			foreach $recref ( @{$self->{requireposition}{$name}{$ref}} ) {
218			push @rv, $self->{reqobjs}[$recref];
219			}
220			}
221			return @rv;
222			}
223	williamc	1.1.2.2
224