ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/Tool.pm
(Generate patch)

Comparing COMP/SCRAM/src/BuildSystem/Tool.pm (file contents):
Revision 1.1 by williamc, Fri Apr 7 08:12:48 2000 UTC vs.
Revision 1.2 by williamc, Mon Aug 28 08:23:09 2000 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines