src/Scram/ScramFunctions.pm

#
# ScramFunctions.pm
#
# Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new()         : A new ScramCommands object
# project(urlstring,dir[,areaname]): Create a project from the given url file
#                                       return the area
# satellite(name,version,installdirectory[,areaname]): create a satellite 
#                                       project from the specified name version
# addareatoDB(ConfigArea[,name[,version]]) : add area to the db 
# globalcache([cachedirectory])) : return the global cache object/set at dir.
# scramprojectdb()              : return the scram project DB object
# areatoolbox(ConfigArea) : return the toolbox of the specified area
# setuptoolsinarea($area[,$toolname[,$toolversion[,toolfile]) : setup
# arch()                : get/set the architecture string

package Scram::ScramFunctions;
use URL::URLcache;
use Utilities::Verbose;
require 5.004;

@ISA=qw(Utilities::Verbose);

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        # -- default settings
        $self->{cachedir}=$ENV{HOME}."/.SCRAM/globalcache";
        $self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
        return $self;
}

sub project {
        my $self=shift;
        my $url=shift;
        my $installarea=shift;

        my $areaname="";
        if ( @_ ) {
          $areaname=shift;
        }
        require Configuration::BootStrapProject;
        my $bs=Configuration::BootStrapProject->
                        new($self->globalcache(),$installarea);
        $self->verbose("BootStrapping $url");
        my $area=$bs->boot($url,$areaname);
        if ( ! defined $area ) {
                $self->error("Unable to create project area");
        }
        $area->archname($self->arch());

        # -- download all tool description files
        my $req=$self->arearequirements($area);
        if ( defined $req ) {
          $req->download($self->areatoolbox($area));
        }  

        return $area;
}

sub setuptoolsinarea {
        my $self=shift;
        my $area=shift;

        # -- initialise 
        $self->_allprojectinitsearcher();

        # -- create a new toolbox object
        my $toolbox=$self->areatoolbox($area);
        $toolbox->searcher($self->_projsearcher());

        if ( @_ ) {
            # -- specific tool specified
            if ( my $rv=$toolbox->toolsetup(@_) ) {
             if ( $rv eq 1 ) {
                print "Unknown tool $toolname @ARGV\n";
                exit 1;
             }
            }
        }
        else {
            # -- setup all tools specified in the requirements doc
            my $reqs=$self->arearequirements($area);
            $self->verbose("Setup ToolBox from Requirements doc ($reqs)");
            $reqs->setup($toolbox);
        }
}

sub satellite {
        my $self=shift;
        my $name=shift;
        my $version=shift;
        my $installarea=shift;

        my $areaname="";
        if ( @_ ) {
          $areaname=shift;
        }

        # -- look up scram database for location
        my $relarea=$self->_lookupareaindb($name,$version);
        if ( ! defined $relarea ) {
          $self->error("Unable to Find Project $name $version");
        }

        # -- create satellite
        my $area=$relarea->satellite($installarea,$areaname);
        $area->archname($self->arch());

        # -- copy setup info - deprecated by toolbox copy method
        #$relarea->copysetup($area->location());

        # -- copy toolbox
        my $rtb=$self->areatoolbox($relarea);
        my $tb=$self->areatoolbox($area);
        $rtb->copytools($tb);

        # -- copy configuration directory
        if ( ! -d $area->location()."/".$area->configurationdir() ) {
          use Utilities::AddDir;
          AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
                $area->location()."/".$area->configurationdir() );
        }

        # -- copy RequirementsDoc
        if ( ! -f $area->requirementsdoc() ) {
          copy( $relarea->requirementsdoc() , $area->requirementsdoc());
        }

        return $area;
}

sub addareatoDB {
        my $self=shift;
        my $area=shift;
        my $tagname=shift;
        my $version=shift;

        # -- create defaults if necessary
        if ( (! defined $version)  || ( $version eq "") ) {
           $version=$area->version();
        }
        if ( (! defined $tagname)  || ( $tagname eq "") ) {
           $tagname=$area->name();
        }

        # -- Add to the DB
        $self->scramprojectdb()->addarea($tagname,$version,$area);
}

sub globalcache {
        my $self=shift;
        if ( @_ ) {
          $self->{cachedir}=shift;
        }
        if ( ! defined $self->{globalcache} ) {
          $self->{globalcache}=URL::URLcache->new($self->{cachedir});
        }
        return $self->{globalcache};
}


sub scramprojectdb {
        my $self=shift;
        if ( @_ ) {
          $self->{scramprojectsdbdir}=shift;
        }
        if ( ! defined $self->{scramprojectsdb} ) {
          require Scram::ScramProjectDB;
          $self->{scramprojectsdb}=Scram::ScramProjectDB->new(
                           $self->{scramprojectsdbdir} );
          $self->{scramprojectsdb}->verbosity($self->verbosity());
        }
        return $self->{scramprojectsdb};
}
 
sub areatoolbox {
        my $self=shift;
        my $area=shift;

        my $name=$area->location();
        if ( ! defined $self->{toolboxes}{$name} ) {
          # -- create a new toolbox object
          require BuildSystem::ToolBox;
          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
          $self->{toolboxes}{$name}->verbosity($self->verbosity());
        }
        return $self->{toolboxes}{$name};
}

sub arearequirements {
        my $self=shift;
        my $area=shift;

        my $name=$area->location();
        if ( ! defined $self->{requirements}{$name} ) {
          # -- create a new toolbox object
          require BuildSystem::Requirements;
          my $doc=$area->requirementsdoc();
          my $cache=$area->cache();
          my $db=$area->objectstore();
          require ActiveDoc::ActiveStore;
          my $astore=ActiveDoc::ActiveStore->new($db,$cache);
          $self->{requirements}{$name}=
                BuildSystem::Requirements->new($astore,"file:".$doc);
          $self->{requirements}{$name}->verbosity($self->verbosity());
          $self->verbose("Requirements Doc (".$self->{requirements}{$name}.
                                  ") for area :\n $name\n initiated from $doc");
        }
        else {
          $self->verbose("Requirements Doc (".$self->{requirements}{$name}.")");
        }
        return $self->{requirements}{$name};
}

sub arch {
        my $self=shift;

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

# -------------- Support Routines ------------------------------


sub _allprojectinitsearcher {
        if ( ! defined $self->{projsearcher} ) {
          my $search=_projsearcher();
          foreach $proj ( $self->scramprojectdb()->list() ) {
           $search->addproject($$proj[0],$$proj[1]);
          }
        }
}

sub _projsearcher {
        if ( ! defined $self->{projsearcher} ) {
          require Scram::ProjectSearcher;
          $self->{projsearcher}=Scram::ProjectSearcher->new(
                        $self->scramprojectdb());
        }
        return $self->{projsearcher};
}


sub _lookupareaindb {
        my $self=shift;

        my $area=undef;
        # -- Look up the area in the databse
        my @areas=$self->scramprojectdb()->getarea(@_);
        if ( $#areas > 0 ) { #ambigous
                # could ask user - for now just error
          $self->error("Ambigous request - please be more specific");
        }
        elsif ( $#areas != 0 ) { #not found
          $self->error("The project requested has not been found");
        }
        else {
          $area=$areas[0];
        }
        return $area;
}
Revision:	1.1.2.7
Committed:	Thu Aug 24 09:59:39 2000 UTC (24 years, 8 months ago) by williamc
Content type:	text/plain
Branch:	HPWbranch
Changes since 1.1.2.6:	+3 -1 lines
Log Message:	New Requiremnts interface
#	User	Rev	Content
1	williamc	1.1.2.1	#
2			# ScramFunctions.pm
3			#
4			# Written by Christopher Williams
5			#
6			# Description
7			#
8			# Interface
9			# ---------
10			# new() : A new ScramCommands object
11			# project(urlstring,dir[,areaname]): Create a project from the given url file
12			# return the area
13			# satellite(name,version,installdirectory[,areaname]): create a satellite
14			# project from the specified name version
15			# addareatoDB(ConfigArea[,name[,version]]) : add area to the db
16			# globalcache([cachedirectory])) : return the global cache object/set at dir.
17			# scramprojectdb() : return the scram project DB object
18			# areatoolbox(ConfigArea) : return the toolbox of the specified area
19			# setuptoolsinarea($area[,$toolname[,$toolversion[,toolfile]) : setup
20	williamc	1.1.2.4	# arch() : get/set the architecture string
21	williamc	1.1.2.1
22			package Scram::ScramFunctions;
23			use URL::URLcache;
24			use Utilities::Verbose;
25			require 5.004;
26
27			@ISA=qw(Utilities::Verbose);
28
29			sub new {
30			my $class=shift;
31			$self={};
32			bless $self, $class;
33			# -- default settings
34	williamc	1.1.2.2	$self->{cachedir}=$ENV{HOME}."/.SCRAM/globalcache";
35	williamc	1.1.2.1	$self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
36			return $self;
37			}
38
39			sub project {
40			my $self=shift;
41			my $url=shift;
42			my $installarea=shift;
43
44			my $areaname="";
45			if ( @_ ) {
46			$areaname=shift;
47			}
48			require Configuration::BootStrapProject;
49			my $bs=Configuration::BootStrapProject->
50			new($self->globalcache(),$installarea);
51	williamc	1.1.2.5	$self->verbose("BootStrapping $url");
52	williamc	1.1.2.1	my $area=$bs->boot($url,$areaname);
53	williamc	1.1.2.6	if ( ! defined $area ) {
54			$self->error("Unable to create project area");
55			}
56	williamc	1.1.2.4	$area->archname($self->arch());
57	williamc	1.1.2.1
58			# -- download all tool description files
59			my $req=$self->arearequirements($area);
60			if ( defined $req ) {
61			$req->download($self->areatoolbox($area));
62			}
63
64			return $area;
65			}
66
67			sub setuptoolsinarea {
68			my $self=shift;
69			my $area=shift;
70
71			# -- initialise
72			$self->_allprojectinitsearcher();
73
74			# -- create a new toolbox object
75			my $toolbox=$self->areatoolbox($area);
76			$toolbox->searcher($self->_projsearcher());
77
78			if ( @_ ) {
79			# -- specific tool specified
80	williamc	1.1.2.3	if ( my $rv=$toolbox->toolsetup(@_) ) {
81	williamc	1.1.2.1	if ( $rv eq 1 ) {
82			print "Unknown tool $toolname @ARGV\n";
83			exit 1;
84			}
85			}
86			}
87			else {
88			# -- setup all tools specified in the requirements doc
89			my $reqs=$self->arearequirements($area);
90			$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
91			$reqs->setup($toolbox);
92			}
93			}
94
95			sub satellite {
96			my $self=shift;
97			my $name=shift;
98			my $version=shift;
99			my $installarea=shift;
100
101			my $areaname="";
102			if ( @_ ) {
103			$areaname=shift;
104			}
105
106			# -- look up scram database for location
107			my $relarea=$self->_lookupareaindb($name,$version);
108			if ( ! defined $relarea ) {
109			$self->error("Unable to Find Project $name $version");
110			}
111
112			# -- create satellite
113			my $area=$relarea->satellite($installarea,$areaname);
114	williamc	1.1.2.4	$area->archname($self->arch());
115	williamc	1.1.2.1
116	williamc	1.1.2.4	# -- copy setup info - deprecated by toolbox copy method
117			#$relarea->copysetup($area->location());
118
119			# -- copy toolbox
120			my $rtb=$self->areatoolbox($relarea);
121			my $tb=$self->areatoolbox($area);
122			$rtb->copytools($tb);
123	williamc	1.1.2.1
124			# -- copy configuration directory
125			if ( ! -d $area->location()."/".$area->configurationdir() ) {
126			use Utilities::AddDir;
127			AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
128			$area->location()."/".$area->configurationdir() );
129			}
130
131			# -- copy RequirementsDoc
132			if ( ! -f $area->requirementsdoc() ) {
133			copy( $relarea->requirementsdoc() , $area->requirementsdoc());
134			}
135
136			return $area;
137			}
138
139			sub addareatoDB {
140			my $self=shift;
141			my $area=shift;
142			my $tagname=shift;
143			my $version=shift;
144
145			# -- create defaults if necessary
146			if ( (! defined $version) \|\| ( $version eq "") ) {
147			$version=$area->version();
148			}
149			if ( (! defined $tagname) \|\| ( $tagname eq "") ) {
150			$tagname=$area->name();
151			}
152
153			# -- Add to the DB
154			$self->scramprojectdb()->addarea($tagname,$version,$area);
155			}
156
157			sub globalcache {
158			my $self=shift;
159			if ( @_ ) {
160			$self->{cachedir}=shift;
161			}
162			if ( ! defined $self->{globalcache} ) {
163			$self->{globalcache}=URL::URLcache->new($self->{cachedir});
164			}
165			return $self->{globalcache};
166			}
167
168
169			sub scramprojectdb {
170			my $self=shift;
171			if ( @_ ) {
172			$self->{scramprojectsdbdir}=shift;
173			}
174			if ( ! defined $self->{scramprojectsdb} ) {
175			require Scram::ScramProjectDB;
176			$self->{scramprojectsdb}=Scram::ScramProjectDB->new(
177			$self->{scramprojectsdbdir} );
178			$self->{scramprojectsdb}->verbosity($self->verbosity());
179			}
180			return $self->{scramprojectsdb};
181			}
182	williamc	1.1.2.6
183	williamc	1.1.2.1	sub areatoolbox {
184			my $self=shift;
185			my $area=shift;
186
187			my $name=$area->location();
188			if ( ! defined $self->{toolboxes}{$name} ) {
189			# -- create a new toolbox object
190			require BuildSystem::ToolBox;
191			$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
192			$self->{toolboxes}{$name}->verbosity($self->verbosity());
193			}
194			return $self->{toolboxes}{$name};
195			}
196
197			sub arearequirements {
198			my $self=shift;
199			my $area=shift;
200
201			my $name=$area->location();
202			if ( ! defined $self->{requirements}{$name} ) {
203			# -- create a new toolbox object
204			require BuildSystem::Requirements;
205			my $doc=$area->requirementsdoc();
206			my $cache=$area->cache();
207	williamc	1.1.2.6	my $db=$area->objectstore();
208	williamc	1.1.2.7	require ActiveDoc::ActiveStore;
209			my $astore=ActiveDoc::ActiveStore->new($db,$cache);
210	williamc	1.1.2.1	$self->{requirements}{$name}=
211	williamc	1.1.2.7	BuildSystem::Requirements->new($astore,"file:".$doc);
212	williamc	1.1.2.1	$self->{requirements}{$name}->verbosity($self->verbosity());
213			$self->verbose("Requirements Doc (".$self->{requirements}{$name}.
214			") for area :\n $name\n initiated from $doc");
215			}
216			else {
217			$self->verbose("Requirements Doc (".$self->{requirements}{$name}.")");
218			}
219			return $self->{requirements}{$name};
220	williamc	1.1.2.4	}
221
222			sub arch {
223			my $self=shift;
224
225			@_?$self->{arch}=shift
226			:$self->{arch};
227	williamc	1.1.2.1	}
228
229			# -------------- Support Routines ------------------------------
230
231
232			sub _allprojectinitsearcher {
233			if ( ! defined $self->{projsearcher} ) {
234			my $search=_projsearcher();
235			foreach $proj ( $self->scramprojectdb()->list() ) {
236			$search->addproject($$proj[0],$$proj[1]);
237			}
238			}
239			}
240
241			sub _projsearcher {
242			if ( ! defined $self->{projsearcher} ) {
243			require Scram::ProjectSearcher;
244			$self->{projsearcher}=Scram::ProjectSearcher->new(
245			$self->scramprojectdb());
246			}
247			return $self->{projsearcher};
248			}
249
250
251			sub _lookupareaindb {
252			my $self=shift;
253
254			my $area=undef;
255			# -- Look up the area in the databse
256			my @areas=$self->scramprojectdb()->getarea(@_);
257			if ( $#areas > 0 ) { #ambigous
258			# could ask user - for now just error
259			$self->error("Ambigous request - please be more specific");
260			}
261			elsif ( $#areas != 0 ) { #not found
262			$self->error("The project requested has not been found");
263			}
264			else {
265			$area=$areas[0];
266			}
267			return $area;
268			}