Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # ========== Copyright Header Begin ========================================== |
2 | # | |
3 | # OpenSPARC T2 Processor File: TRELoad.pm | |
4 | # Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved | |
5 | # 4150 Network Circle, Santa Clara, California 95054, U.S.A. | |
6 | # | |
7 | # * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. | |
8 | # | |
9 | # This program is free software; you can redistribute it and/or modify | |
10 | # it under the terms of the GNU General Public License as published by | |
11 | # the Free Software Foundation; version 2 of the License. | |
12 | # | |
13 | # This program is distributed in the hope that it will be useful, | |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | # GNU General Public License for more details. | |
17 | # | |
18 | # You should have received a copy of the GNU General Public License | |
19 | # along with this program; if not, write to the Free Software | |
20 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
21 | # | |
22 | # For the avoidance of doubt, and except that if any non-GPL license | |
23 | # choice is available it will apply instead, Sun elects to use only | |
24 | # the General Public License version 2 (GPLv2) at this time for any | |
25 | # software where a choice of GPL license versions is made | |
26 | # available with the language indicating that GPLv2 or any later version | |
27 | # may be used, or where a choice of which version of the GPL is applied is | |
28 | # otherwise unspecified. | |
29 | # | |
30 | # Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara, | |
31 | # CA 95054 USA or visit www.sun.com if you need additional information or | |
32 | # have any questions. | |
33 | # | |
34 | # ========== Copyright Header End ============================================ | |
35 | package TRELoad; | |
36 | ||
37 | use 5.008; | |
38 | use strict; | |
39 | use warnings; | |
40 | use Carp qw(!&verbose); | |
41 | use File::Spec; | |
42 | require Exporter; | |
43 | ||
44 | our @ISA = qw(Exporter); | |
45 | ||
46 | # Items to export into callers namespace by default. Note: do not export | |
47 | # names by default without a very good reason. Use EXPORT_OK instead. | |
48 | # Do not simply export all your public functions/methods/constants. | |
49 | ||
50 | # This allows declaration use TRELoad ':all'; | |
51 | # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK | |
52 | # will save memory. | |
53 | our %EXPORT_TAGS = ( 'all' => [ qw( | |
54 | ||
55 | ) ] ); | |
56 | ||
57 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | |
58 | ||
59 | our @EXPORT = qw( | |
60 | ||
61 | ); | |
62 | ||
63 | our $VERSION = '1.02'; | |
64 | our $Id = 'TRELoad: '; | |
65 | our $Verbose = 0 unless defined $Verbose; | |
66 | ||
67 | our $ModuleBase = $ENV{PERL_MODULE_BASE}; | |
68 | ||
69 | our $PerlVers = '5.8.0'; | |
70 | our $TRE_ENTRY = $ENV{TRE_ENTRY}; | |
71 | ||
72 | our %Loaded; | |
73 | ||
74 | ||
75 | ######################################################################### | |
76 | ||
77 | sub import { | |
78 | my @args = @_; | |
79 | ||
80 | my @caller = caller; | |
81 | my $callpkg = $caller[0]; | |
82 | if($callpkg ne 'main') { | |
83 | $TRE_ENTRY .= '/' unless $TRE_ENTRY =~ m|/$|; | |
84 | $TRE_ENTRY .= $callpkg; | |
85 | ||
86 | } | |
87 | ||
88 | print "$Id CALLING from '$callpkg' with entry '$TRE_ENTRY'\n" if $Verbose; | |
89 | ||
90 | my @modules = parse_import_list(@_); | |
91 | foreach my $importmod (@modules) { | |
92 | my $module = $importmod->{module}; | |
93 | my $importlist = exists $importmod->{importlist} ? | |
94 | $importmod->{importlist} : [':DEFAULT']; | |
95 | my $tre_entry = $importmod->{tre_entry}; | |
96 | ||
97 | if(@$importlist and $importlist->[0] =~ /^\!/) { | |
98 | # First element is a deletion, so prepend :DEFAULT | |
99 | unshift @$importlist, ':DEFAULT'; | |
100 | } | |
101 | ||
102 | my $module_dir = get_module_dir($module, $tre_entry); | |
103 | my $libdir = File::Spec->catdir($module_dir, 'lib', 'site_perl', | |
104 | $PerlVers); | |
105 | unshift @INC, $libdir; | |
106 | # Perhaps we'd need to add this to PERL5LIB to make C libraries work. | |
107 | # Add that if we need to. | |
108 | ||
109 | print "$Id Searching for module $module in $libdir.\n" if $Verbose; | |
110 | ||
111 | require "$module.pm"; | |
112 | ||
113 | local ($_); | |
114 | my @symbol_list = map { get_tag_contents($module, $_) } @$importlist; | |
115 | @symbol_list = negate_symbols(@symbol_list); | |
116 | ||
117 | if(@symbol_list) { | |
118 | ||
119 | my $caller = caller; | |
120 | print "$Id Exporting symbols from $module into $caller: @symbol_list \n" | |
121 | if $Verbose; | |
122 | # $Exporter::Verbose = 1; | |
123 | ||
124 | ||
125 | $module->export_to_level(1, $module, @symbol_list); | |
126 | } | |
127 | ||
128 | } | |
129 | ||
130 | ||
131 | } | |
132 | ||
133 | ######################################################################### | |
134 | ||
135 | sub get_module_dir { | |
136 | my $module = shift; | |
137 | my $tre_entry = shift; | |
138 | ||
139 | my $command = "configsrch $module $tre_entry"; | |
140 | my $cmd_output = `$command`; | |
141 | if($?) { | |
142 | my $status = $? >> 8; | |
143 | my $signal = $? & 127; | |
144 | my $core = $? & 128; | |
145 | ||
146 | if($status) { | |
147 | confess "Execution of \"$command\" failed with status $status.\n"; | |
148 | } | |
149 | if($signal) { | |
150 | my $corestring = $core ? '' : ' (core dumped)'; | |
151 | confess "Command \"$command\" died with signal $signal$corestring.\n"; | |
152 | } | |
153 | # should never get here | |
154 | die "$command failed\n"; | |
155 | } | |
156 | my @words = split ' ', $cmd_output; | |
157 | my $version = shift @words; | |
158 | ||
159 | if($version !~ /\d+.\d+/) { | |
160 | croak "Could not find TRE version for module $module.\n"; | |
161 | } | |
162 | ||
163 | if(exists $Loaded{$module}) { | |
164 | my $loaded_vers = $Loaded{$module}; | |
165 | if($version ne $loaded_vers) { | |
166 | warn << "EOT"; | |
167 | $Id WARNING: Previously loaded $module version $loaded_vers, but now TRE_ENTRY | |
168 | $tre_entry | |
169 | specfies version $version. You cannot load two different | |
170 | versions of the same module in a script, so going with version $loaded_vers. | |
171 | This may lead to unexpected behavior. | |
172 | EOT | |
173 | } | |
174 | } else { | |
175 | $Loaded{$module} = $version; | |
176 | } | |
177 | ||
178 | my $module_dir = File::Spec->catdir($ModuleBase, $module, $version); | |
179 | croak "Model directory \"$module_dir\" does not exist.\n" | |
180 | unless -d $module_dir; | |
181 | ||
182 | # Obviously, this will need to do the right thing once TRE is in place. | |
183 | return $module_dir; | |
184 | } | |
185 | ||
186 | ######################################################################### | |
187 | ||
188 | sub negate_symbols { | |
189 | my @symbols_in = @_; | |
190 | ||
191 | local ($_); | |
192 | my %hash = map {$_, 1} @symbols_in; | |
193 | foreach my $key (keys %hash) { | |
194 | if($key =~ /^\!(.*)/) { | |
195 | delete $hash{$key}; | |
196 | delete $hash{$1}; | |
197 | } | |
198 | } | |
199 | return keys %hash; | |
200 | } | |
201 | ||
202 | ######################################################################### | |
203 | ||
204 | sub parse_import_list { | |
205 | my @import_list = @_; | |
206 | ||
207 | my $curpkg = shift @import_list; | |
208 | ||
209 | ||
210 | print "$Id Parsing import list...\n" if $Verbose; | |
211 | ||
212 | my @parsed; | |
213 | my $i = 0; | |
214 | my $start_len = $#import_list + 1; | |
215 | while($i < $start_len) { | |
216 | my $entry = {}; | |
217 | $entry->{module} = $import_list[$i++]; | |
218 | print "$Id module $entry->{module}\n" if $Verbose; | |
219 | if(ref $import_list[$i]) { | |
220 | if(ref $import_list[$i] eq 'ARRAY') { | |
221 | $entry->{importlist} = $import_list[$i++]; | |
222 | print "$Id import @{$entry->{importlist}}\n" if $Verbose; | |
223 | } elsif(ref $import_list[$i] eq 'HASH') { | |
224 | $entry->{hash} = $import_list[$i++]; | |
225 | if(exists $entry->{hash}{import}) { | |
226 | $entry->{importlist} = $entry->{hash}{import}; | |
227 | print "$Id import @{$entry->{importlist}}\n" if $Verbose; | |
228 | } | |
229 | if(exists $entry->{hash}{tre_entry}) { | |
230 | $entry->{tre_entry} = $entry->{hash}{tre_entry}; | |
231 | print "$Id treentry $entry->{tre_entry}\n" if $Verbose; | |
232 | ||
233 | } | |
234 | } | |
235 | } | |
236 | $entry->{tre_entry} = $TRE_ENTRY unless exists $entry->{tre_entry}; | |
237 | push @parsed, $entry; | |
238 | } | |
239 | ||
240 | print "$Id Done parsing import list.\n" if $Verbose; | |
241 | ||
242 | return @parsed; | |
243 | } | |
244 | ||
245 | ######################################################################### | |
246 | ||
247 | sub get_tag_contents { | |
248 | my $pkg = shift; | |
249 | my $tag = shift; | |
250 | ||
251 | my $is_negated = 0; | |
252 | if($tag =~ s/^\!//) { | |
253 | $is_negated = 1; | |
254 | } | |
255 | ||
256 | print "$Id Expanding module=$pkg tag=$tag\n" if $Verbose; | |
257 | if(defined $tag and $tag !~ /^:/) { | |
258 | $tag = "!$tag" if $is_negated; | |
259 | print "$Id $tag\n" if $Verbose; | |
260 | return $tag; | |
261 | } else { | |
262 | $tag =~ s/^://; | |
263 | } | |
264 | ||
265 | my %tags; | |
266 | my @export; | |
267 | { | |
268 | # add a block where I can break all the rules | |
269 | no strict 'refs'; | |
270 | %tags = %{"$pkg" . "::EXPORT_TAGS" }; | |
271 | @export = @{"$pkg" . "::EXPORT" }; | |
272 | } | |
273 | ||
274 | if(exists $tags{$tag}) { | |
275 | @{$tags{$tag}} = map { "!$_" } @{$tags{$tag}} if $is_negated; | |
276 | print "$Id @{$tags{$tag}}\n" if $Verbose; | |
277 | return @{$tags{$tag}}; | |
278 | } elsif($tag eq 'DEFAULT') { | |
279 | print "$Id @export\n" if $Verbose; | |
280 | @export = map { "!$_" } @export if $is_negated; | |
281 | return @export; | |
282 | } else { | |
283 | confess "No such tag $tag in package $pkg\n"; | |
284 | } | |
285 | } | |
286 | ||
287 | ######################################################################### | |
288 | ||
289 | ||
290 | ||
291 | 1; | |
292 | __END__ | |
293 | ||
294 | =head1 NAME | |
295 | ||
296 | TRELoad - Perl extension for loading modules under TRE control | |
297 | ||
298 | =head1 SYNOPSIS | |
299 | ||
300 | use TRELoad 'Foo' => ['abc', 'def'], | |
301 | 'Bar', | |
302 | 'Baz' => [ '$somevar' ]; | |
303 | ||
304 | which is the same as | |
305 | ||
306 | use Foo 'abc', 'def'; | |
307 | use Bar; | |
308 | use Baz '$somevar'; | |
309 | ||
310 | ||
311 | =head1 ABSTRACT | |
312 | ||
313 | This module adds a layer of indirection between modules under | |
314 | TRE control and the scripts/modules that use them. It allows | |
315 | the TRE-controlled modules to be intstalled unmodified. TRELoad | |
316 | emulates the Exporter, so client modules are able to import | |
317 | symbols from the TRE modules. | |
318 | ||
319 | =head1 DESCRIPTION | |
320 | ||
321 | The TRELoad module exists as a layer of indirection between perl | |
322 | modules under TRE control and scripts/modules that use them. The | |
323 | basic idea is that we want to use TRE mechanisms to find perl modules, | |
324 | rather than the include mechanisms built into perl. That said, we | |
325 | want to support arbitrary perl modules and fully export the perl | |
326 | exporter. | |
327 | ||
328 | =head2 USING A TRE MODULE | |
329 | ||
330 | The entire usage for the TRELoad module is the 'use' line. The syntax is: | |
331 | ||
332 | use TRELoad <list>; | |
333 | ||
334 | In its simplest (and most common) usage, the list contains the names | |
335 | of modules to import. For instance, the TRE equivalent of: | |
336 | ||
337 | use Foo; | |
338 | use Bar; | |
339 | ||
340 | is | |
341 | ||
342 | use TRELoad 'Foo', 'Bar'; | |
343 | ||
344 | With this syntax (i.e., no import list explicitly defined for the | |
345 | modules), you import symbols in the default export list, just as you | |
346 | would with the bare 'use' directives. | |
347 | ||
348 | A normal use directive can also contain a list of symbols to import, | |
349 | which override the default export list of the module. For instance: | |
350 | ||
351 | use Foo 'abc', 'def'; | |
352 | ||
353 | will load the Foo module and import the symbols 'abc' and 'def' | |
354 | instead of the default export list. The TRELoad equivalent is to use | |
355 | an array reference immediately following the module name in the | |
356 | TRELoad argument list. The above TRELoad equivalent would be: | |
357 | ||
358 | use TRELoad 'Foo' => ['abc', 'def']; | |
359 | ||
360 | The perl exporter also supports tags (pseudo-symbols starting with | |
361 | ':'), which are names for lists of symbols. There is a predefined tag | |
362 | called ':DEFAULT' which contains all of the symbols in the default | |
363 | export list. These tags are also supported by TRELoad. Therefore, | |
364 | the following statement: | |
365 | ||
366 | use Foo ':DEFAULT', 'abc'; | |
367 | ||
368 | has the TRE equivalent of: | |
369 | ||
370 | use TRELoad 'Foo' => [':DEFAULT', 'abc'] | |
371 | ||
372 | which means to import all symbols in the default export list, plus the | |
373 | symbol 'abc'. | |
374 | ||
375 | TRELoad also supports negations, see 'perldoc Exporter' for more | |
376 | details. As a more complicated example, consider: | |
377 | ||
378 | use Foo 'abc'; | |
379 | use Bar ':DEFAULT', 'aaa', '!bbb', '!:ccc'; | |
380 | use Baz; | |
381 | ||
382 | This means, load Foo, Bar, and Baz. Import the symbol 'abc' from Foo, | |
383 | import all the default symbols from Bar, plus 'aaa', minus the symbol | |
384 | 'bbb' and minus all symbols in the tag ':ccc'. Finally, import the | |
385 | symbols in the default export list from Baz. | |
386 | ||
387 | The TRE equivalent is: | |
388 | ||
389 | use TRELoad 'Foo' => [ 'abc' ], | |
390 | 'Bar' => [ ':DEFAULT', 'aaa', '!bbb', '!:ccc'], | |
391 | 'Baz'; | |
392 | ||
393 | I assume you get the idea. | |
394 | ||
395 | =head2 OVERRIDING TRE_ENTRY | |
396 | ||
397 | The TRELoad module obeys the TRE mechanism of appending tool paths to | |
398 | TRE_ENTRY. It is possible, however, to override the TRE_ENTRY | |
399 | setting. To do this requires a more general syntax. Basically, | |
400 | whereever an array reference can appear in the usage list, you may | |
401 | substitute a hash reference. The legal keys of this hash are 'import' | |
402 | (whose value is an array reference that is treated as an import list) | |
403 | and 'tre_entry' (whose value is intrepreted as a string to use as a | |
404 | value for TRE_ENTRY). | |
405 | ||
406 | For example: | |
407 | ||
408 | use TRELoad 'Foo' => ['abc', 'def']; | |
409 | ||
410 | and | |
411 | ||
412 | use TRELoad 'Foo' => { import => ['abc', 'def'] }; | |
413 | ||
414 | are exactly identical. | |
415 | ||
416 | use TRELoad 'Foo' => { import => ['abc', 'def'], | |
417 | tre_entry => '/SomeTool' }; | |
418 | ||
419 | is the same thing except that it will use the TRE_ENTRY of | |
420 | "/SomeTool". | |
421 | ||
422 | ||
423 | =head2 INSTALLING A MODULE | |
424 | ||
425 | Modules are installed using the normal perl install mechanism. The | |
426 | only TRE-specific step is to override the default install prefix: | |
427 | ||
428 | make clean # if Makefile is already present | |
429 | perl Makefile.PL \ | |
430 | PREFIX=$PERL_MODULE_BASE/<module_name>/<version> | |
431 | make | |
432 | make install | |
433 | ||
434 | If it is a new module, you will also need to add a .tver entry for the | |
435 | module name. | |
436 | ||
437 | =head2 EXPORT | |
438 | ||
439 | None. | |
440 | ||
441 | =head2 RESTRICTIONS | |
442 | ||
443 | There are couple of restrictions to be aware of: | |
444 | ||
445 | =over 4 | |
446 | ||
447 | =item | |
448 | ||
449 | You cannot use pattern rules in an import list (i.e., import symbols | |
450 | that begin with '/' or '!/'. There is no reason this could not be made | |
451 | to work, but it is a fair amount of work and this feature is almost | |
452 | never used. | |
453 | ||
454 | =item | |
455 | ||
456 | You can only use TRELoad on a top-level module. For instance, if a | |
457 | module Foo contains a Foo.pm with interface code for the underlying | |
458 | modules Foo::Bar and Foo::Baz, you must use a "use TRELoad 'Foo'", | |
459 | since Foo::Bar and Foo::Baz will not be recognized by configsrch. If | |
460 | you need to use those modules directly (which usually is not a good | |
461 | idea), you can do: | |
462 | ||
463 | use TRELoad 'Foo'; | |
464 | use Foo::Bar; | |
465 | use Foo::Baz; | |
466 | ||
467 | The TRELoad line will add the appropriate version of Foo to the | |
468 | include path, so you can just use a regular 'use' for its sub-modules. | |
469 | ||
470 | ||
471 | ||
472 | =item | |
473 | ||
474 | Using a number to specify a minimum version is not supported (as in: | |
475 | "use Foo 3.01;") on the TRELoad 'use' line. You can get the effect, | |
476 | however, by using: | |
477 | ||
478 | use TRELoad 'Foo'; | |
479 | use Foo 3.01; | |
480 | ||
481 | The TRELoad line will add the correct version of Foo to the include | |
482 | path, so the following line will work correctly. | |
483 | ||
484 | =item | |
485 | ||
486 | Use perl-style version numbers for your TRE versions. That is to say, | |
487 | use two decimal places after the '.'. The reason is that perl does a | |
488 | simple ASCII comparison when it compares version numbers, so it | |
489 | believes 1.9 to be more recent than 1.10 . TRE does not care, but perl | |
490 | does, so if users want to check the version of the module (see | |
491 | previous bullet), this convention is required. | |
492 | ||
493 | ||
494 | =item | |
495 | ||
496 | You cannot load two different versions of a module in the same script. | |
497 | For instance, suppose you had a module called Abc and another module | |
498 | called Composite, where Composite itself used Abc. If your .tver file | |
499 | consisted of: | |
500 | ||
501 | Abc / 1.01 | |
502 | Abc /Composite 1.02 | |
503 | Composite / 2.01 | |
504 | ||
505 | you would be able to use Abc by itself, and you would get version | |
506 | 1.01 . You could use Composite by itself, which would get version 1.02 | |
507 | of Abc. What you cannot do is include Abc by itself AND from within | |
508 | Composite via something like: | |
509 | ||
510 | use TRELoad 'Abc', 'Composite'; | |
511 | ||
512 | This is because it would try to load BOTH versions of 1.01 and 1.02 | |
513 | of Abc in the same interpreter, and the names would conflict. In this | |
514 | case, TRELoad prints a warning message to stderr and uses the first | |
515 | version loaded of the module in question. It is impossible to make | |
516 | this work without modifying the modules themselves, and the major | |
517 | design goal of TRELoad was to enable the TRE use of arbitrary perl | |
518 | modules. | |
519 | ||
520 | =back | |
521 | ||
522 | =head1 SEE ALSO | |
523 | ||
524 | perlmod(1), Exporter(3), | |
525 | ||
526 | =cut |