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)
# listtype(type) : return a list of all features of the specified type
# 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
# store(location)   : Save object to given file
# restore(location) : Restore object from specified file
# reset()           : Clean out all the features

package BuildSystem::Tool;
use Utilities::Verbose;
require 5.004;
@ISA=qw(Utilities::Verbose);

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 listtype {
        my $self=shift;
        my $type=shift;

        my @list=();
        foreach $v ( $self->features() ) {
          if ( $self->type($v) eq $type ) {
                push @list, $v;
          }
        }
        return @list;
}

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 reset {
        my $self=shift;
        undef $self->{features};
        undef $self->{'features_ordered'};
        undef $self->{reqobjs};
        undef $self->{requireposition};
}

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 store {
        my $self=shift;
        my $location=shift;

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