1 |
williamc |
1.1 |
# Toolbox Class to process tool functionality information
|
2 |
|
|
#
|
3 |
|
|
#
|
4 |
|
|
|
5 |
|
|
package ToolBox;
|
6 |
williamc |
1.2 |
require 5.001;
|
7 |
williamc |
1.1 |
require Exporter;
|
8 |
|
|
@ISA=qw(Exporter);
|
9 |
|
|
use Carp;
|
10 |
williamc |
1.2 |
use Utilities::SCRAMUtils;
|
11 |
williamc |
1.1 |
|
12 |
|
|
# A new toolbox object
|
13 |
|
|
sub new {
|
14 |
|
|
$self = {};
|
15 |
|
|
bless $self;
|
16 |
|
|
$self->{toolboxfile}=SCRAMUtils::checkfile("$ENV{INTwork}/Toolfile");
|
17 |
|
|
if ( $self->{toolboxfile} eq "" ) {
|
18 |
|
|
$self->{toolboxfile}="$ENV{LOCALTOP}/$ENV{INTwork}/Toolfile";
|
19 |
|
|
}
|
20 |
|
|
#print "ToolboxFile = ".$self->{toolboxfile}."\n";
|
21 |
|
|
$self->readtoolfile;
|
22 |
|
|
$self->typehashdefaults;
|
23 |
|
|
$self->readtypehash;
|
24 |
|
|
return $self;
|
25 |
|
|
}
|
26 |
|
|
|
27 |
|
|
sub readtoolfile {
|
28 |
|
|
my $self=shift;
|
29 |
|
|
|
30 |
|
|
open ( FILEIN, $self->{toolboxfile} );
|
31 |
|
|
#or print "Unable to find $self->{toolboxfile} \n";
|
32 |
|
|
while ( <FILEIN> ) {
|
33 |
|
|
next if /^\s*$/;
|
34 |
|
|
next if /^\s*#/;
|
35 |
|
|
($out,$in,@functions)=split /:/, $_;
|
36 |
|
|
${$self->{toolhash}}{$name}=@functions;
|
37 |
|
|
}
|
38 |
|
|
close FILEIN;
|
39 |
|
|
}
|
40 |
|
|
|
41 |
|
|
# temporary for now
|
42 |
|
|
sub typehashdefaults {
|
43 |
|
|
my $self=shift;
|
44 |
|
|
|
45 |
|
|
%{$self->{typehash}}=(
|
46 |
|
|
'.C' => 'C++Src',
|
47 |
|
|
'.cc' => 'C++Src',
|
48 |
|
|
'.cpp' => 'C++Src',
|
49 |
|
|
'.F' => 'FortranSrc',
|
50 |
|
|
'.f' => 'FortranSrc'
|
51 |
|
|
)
|
52 |
|
|
}
|
53 |
|
|
|
54 |
|
|
sub readtypehash {
|
55 |
|
|
my $self=shift;
|
56 |
|
|
my $toolfile="$ENV{INTwork}/filetypes";
|
57 |
|
|
my $type;
|
58 |
|
|
my $ext;
|
59 |
|
|
|
60 |
|
|
$toolfile=SCRAMUtils::checkfile($toolfile);
|
61 |
|
|
open ( FILEIN, $toolfile ) or return;
|
62 |
|
|
while ( <FILEIN> ) {
|
63 |
|
|
next if /^\s*$/;
|
64 |
|
|
next if /^\s*#/;
|
65 |
|
|
($ext,$type)=split /:/, $_;
|
66 |
|
|
${$self->{typehash}}{$ext}=$type;
|
67 |
|
|
}
|
68 |
|
|
close FILEIN;
|
69 |
|
|
}
|
70 |
|
|
|
71 |
|
|
sub gettool {
|
72 |
|
|
my $self=shift;
|
73 |
|
|
my $out=shift;
|
74 |
|
|
my $in=shift;
|
75 |
|
|
|
76 |
|
|
if ( exists ${$self->{toolhash}}{"$out:$in"}){
|
77 |
|
|
return ${$self->{toolhash}}{"$out:$in"};
|
78 |
|
|
}
|
79 |
|
|
else {
|
80 |
|
|
# autofinding mechanism not yet implemented
|
81 |
|
|
carp "ToolBox: Unable to find a tool to convert $in -> $out\n";
|
82 |
|
|
}
|
83 |
|
|
}
|
84 |
|
|
|
85 |
|
|
#
|
86 |
|
|
# return the class of a given file extension
|
87 |
|
|
#
|
88 |
|
|
sub getclass {
|
89 |
|
|
my $self=shift;
|
90 |
|
|
my $file=shift;
|
91 |
|
|
|
92 |
|
|
chomp $file;
|
93 |
|
|
foreach $key ( keys %{$self->{typehash}}) {
|
94 |
|
|
if ( $file=~/$key\Z/ ) {
|
95 |
|
|
return ${$self->{$typehash}}{$key};
|
96 |
|
|
}
|
97 |
|
|
}
|
98 |
|
|
carp "ToolBox: Unknown File Type $file\n";
|
99 |
|
|
}
|
100 |
|
|
|
101 |
|
|
#
|
102 |
|
|
# Make targets for all types that match out, in combination
|
103 |
|
|
sub maketargets ($output, $input, $target, $deps) {
|
104 |
|
|
my $self=shift;
|
105 |
|
|
my $output=shift;
|
106 |
|
|
my $input=shift;
|
107 |
|
|
my $target=shift;
|
108 |
|
|
my $deps=shift;
|
109 |
|
|
my $tool;
|
110 |
|
|
|
111 |
|
|
my @tools;
|
112 |
|
|
|
113 |
|
|
@tools=$self->gettool($output,$input);
|
114 |
|
|
foreach $tool ( @tools ) {
|
115 |
|
|
($typesstring, $toolname, $toolversion, @rest) = split ":", $tool;
|
116 |
|
|
$toolline = join '', @rest;
|
117 |
|
|
@rest=split ';', $toolline;
|
118 |
|
|
$typesstring=~s/:/_/g;;
|
119 |
|
|
print GNUmakefile $target."_".$typesstring.": $deps\n";
|
120 |
|
|
foreach $toolline (@rest) {
|
121 |
|
|
$toolline=~s/\$outfile/$target/g;
|
122 |
|
|
$toolline=~s/\$infile/$deps/g;
|
123 |
|
|
print GNUmakefile "\t$toolline\n";
|
124 |
|
|
}
|
125 |
|
|
print "\n";
|
126 |
|
|
}
|
127 |
|
|
}
|
128 |
|
|
|
129 |
|
|
sub addtotoolbox {
|
130 |
|
|
my $self=shift;
|
131 |
williamc |
1.2 |
use Utilities::SCRAMUtils;
|
132 |
williamc |
1.1 |
my $out=shift;
|
133 |
|
|
my $in=shift;
|
134 |
|
|
my $toolkey=shift;
|
135 |
|
|
my $commandstring =shift;
|
136 |
|
|
my @types = @_;
|
137 |
|
|
|
138 |
|
|
my $fulltypes=join ';', @types;
|
139 |
|
|
my $key="$out:$in";
|
140 |
|
|
my $fullkey=$key.";$fulltypes:$toolkey:";
|
141 |
|
|
$fullkey=~s/;;*/;/g;
|
142 |
|
|
updatelookup($self->{toolboxfile}, $fullkey, $commandstring);
|
143 |
|
|
}
|