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
# addrequirement() : add a requirement at the current parse position
# dependencies()   : return a list of dependency objects

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 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 _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.1
Committed:	Fri Apr 7 08:12:48 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_11_1, V0_11_0
Changes since 1.1:	+162 -0 lines
Log Message:	reworked to interface with toolbox unit
#	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			# addrequirement() : add a requirement at the current parse position
22			# dependencies() : return a list of dependency objects
23
24			package BuildSystem::Tool;
25			require 5.004;
26
27			sub new {
28			my $class=shift;
29			my $self={};
30			bless $self, $class;
31			return $self;
32			}
33
34			sub name {
35			my $self=shift;
36
37			@_?$self->{name}=shift
38			:$self->{name};
39			}
40
41			sub version {
42			my $self=shift;
43
44			@_?$self->{version}=shift
45			:$self->{version};
46			}
47
48			sub url {
49			my $self=shift;
50
51			@_?$self->{url}=shift
52			:$self->{url};
53			}
54
55
56			sub addfeature {
57			my $self=shift;
58			my $name=shift;
59			my @value=@_;
60
61			$self->_newfeature($name,@value);
62			push @{$self->{features}{$name}}, @value;
63			}
64
65			sub setfeature {
66			my $self=shift;
67			my $name=shift;
68			my @value=@_;
69
70			$self->_newfeature($name,@value);
71			@{$self->{features}{$name}}=@value;
72			}
73
74
75			sub _newfeature {
76			my $self=shift;
77			my $name=shift;
78			my @value=@_;
79
80			# if it dosnt exist , make sure we first mark all the current reqs
81			# get inserted beforehand
82			if ( ! exists $self->{features}{$name} ) {
83			# add feature name to our ordered list
84			push @{$self->{'features_ordered'}},$name;
85			for ( $i=0; $i<=$#{$self->{reqobjs}}; $i++ ) {
86			$self->_recordpos( $name, $i);
87			}
88			}
89			}
90
91			sub features {
92			my $self=shift;
93
94			# return (keys %{$self->{features}});
95			return @{$self->{'features_ordered'}};
96			}
97
98			sub getfeature {
99			my $self=shift;
100			my $name=shift;
101
102			my @rv=();
103			my @rep;
104			# make sure we insert requirements at the right place
105			for ( my $i=-1; $i<=$#{$self->{features}{$name}}; $i++ ) {
106			if ( $i>=0 ) {
107			push @rv, $self->{features}{$name}[$i];
108			}
109			my @rep=$self->_testpos($name, $i);
110			my $repobj;
111			foreach $repobj ( @rep ) {
112			push @rv, $repobj->getfeature($name);
113			}
114			}
115			return @rv;
116			}
117
118			sub clearfeature {
119			my $self=shift;
120			my $name=shift;
121
122			undef @{$self->{features}{$name}};
123			}
124
125			sub addrequirement {
126			my $self=shift;
127			my $reqobj=shift;
128
129			push @{$self->{reqobjs}}, $reqobj;
130			foreach $key ( keys %{$self->{features}} ) {
131			$self->_recordpos($key,$#{$self->{reqobjs}});
132			}
133			}
134
135			sub dependencies {
136			my $self=shift;
137			return @{$self->{recobjs}}
138			}
139
140			sub _recordpos {
141			my $self=shift;
142			my $name=shift;
143			my $recref=shift;
144
145			push @{$self->{requireposition}{$name}{$#{$self->{features}{$name}}}}
146			,$recref;
147			}
148
149			# return array of objects that correspond to the required position
150			sub _testpos {
151			my $self=shift;
152			my $name=shift;
153			my $ref=shift;
154
155			my @rv=();
156			if ( exists $self->{requireposition}{$name}{$ref} ) {
157			foreach $recref ( @{$self->{requireposition}{$name}{$ref}} ) {
158			push @rv, $self->{reqobjs}[$recref];
159			}
160			}
161			return @rv;
162			}