[ViewVC] Diff of: cvsroot/COMP/SCRAM/src/BuildSystem/Tool.pm

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.1.2.2 by williamc, Mon Apr 10 16:41:04 2000 UTC

-+
+#
-+
+# 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;
-+
+}
-+
-+

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

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.1.2.2 by williamc, Mon Apr 10 16:41:04 2000 UTC

Diff Legend

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.1.2.2 by williamc, Mon Apr 10 16:41:04 2000 UTC