[1980] | 1 | #!/usr/bin/env perl |
---|
| 2 | #------------------------------------------------------------------------------- |
---|
| 3 | # (C) Crown copyright Met Office. All rights reserved. |
---|
| 4 | # For further details please refer to the file COPYRIGHT.txt |
---|
| 5 | # which you should have received as part of this distribution. |
---|
| 6 | #------------------------------------------------------------------------------- |
---|
| 7 | |
---|
| 8 | use strict; |
---|
| 9 | use warnings; |
---|
| 10 | |
---|
| 11 | use Fcm::Timer qw{timestamp_command}; |
---|
| 12 | |
---|
| 13 | # Function declarations |
---|
| 14 | sub catfile; |
---|
| 15 | sub basename; |
---|
| 16 | sub dirname; |
---|
| 17 | |
---|
| 18 | # ------------------------------------------------------------------------------ |
---|
| 19 | |
---|
| 20 | # Module level variables |
---|
| 21 | my %unusual_tool_name = (); |
---|
| 22 | |
---|
| 23 | # ------------------------------------------------------------------------------ |
---|
| 24 | |
---|
| 25 | MAIN: { |
---|
| 26 | # Name of program |
---|
| 27 | my $this = basename $0; |
---|
| 28 | |
---|
| 29 | # Arguments |
---|
| 30 | my $subcommand = shift @ARGV; |
---|
| 31 | my ($function, $type) = split /:/, $subcommand; |
---|
| 32 | |
---|
| 33 | my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata); |
---|
| 34 | |
---|
| 35 | if ($function eq 'archive') { |
---|
| 36 | ($target, @objects) = @ARGV; |
---|
| 37 | |
---|
| 38 | } elsif ($function eq 'load') { |
---|
| 39 | ($srcpackage, $src, $target, @blockdata) = @ARGV; |
---|
| 40 | |
---|
| 41 | } else { |
---|
| 42 | ($srcpackage, $src, $target, $requirepp) = @ARGV; |
---|
| 43 | } |
---|
| 44 | |
---|
| 45 | # Set up hash reference for all the required information |
---|
| 46 | my %info = ( |
---|
| 47 | SRCPACKAGE => $srcpackage, |
---|
| 48 | SRC => $src, |
---|
| 49 | TYPE => $type, |
---|
| 50 | TARGET => $target, |
---|
| 51 | REQUIREPP => $requirepp, |
---|
| 52 | OBJECTS => \@objects, |
---|
| 53 | BLOCKDATA => \@blockdata, |
---|
| 54 | ); |
---|
| 55 | |
---|
| 56 | # Get list of unusual tools |
---|
| 57 | my $i = 0; |
---|
| 58 | while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) { |
---|
| 59 | my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i); |
---|
| 60 | $unusual_tool_name{$label} = $value; |
---|
| 61 | $i++; |
---|
| 62 | } |
---|
| 63 | |
---|
| 64 | # Invoke the action |
---|
| 65 | my $rc = 0; |
---|
| 66 | if ($function eq 'compile') { |
---|
| 67 | $rc = &compile (\%info); |
---|
| 68 | |
---|
| 69 | } elsif ($function eq 'load') { |
---|
| 70 | $rc = &load (\%info); |
---|
| 71 | |
---|
| 72 | } elsif ($function eq 'archive') { |
---|
| 73 | $rc = &archive (\%info); |
---|
| 74 | |
---|
| 75 | } else { |
---|
| 76 | print STDERR $this, ': incorrect usage, abort'; |
---|
| 77 | $rc = 1; |
---|
| 78 | } |
---|
| 79 | |
---|
| 80 | # Throw error if action failed |
---|
| 81 | if ($rc) { |
---|
| 82 | print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n"; |
---|
| 83 | exit 1; |
---|
| 84 | |
---|
| 85 | } else { |
---|
| 86 | exit; |
---|
| 87 | } |
---|
| 88 | } |
---|
| 89 | |
---|
| 90 | # ------------------------------------------------------------------------------ |
---|
| 91 | # SYNOPSIS |
---|
| 92 | # $rc = &compile (\%info); |
---|
| 93 | # |
---|
| 94 | # DESCRIPTION |
---|
| 95 | # This method invokes the correct compiler with the correct options to |
---|
| 96 | # compile the source file into the required target. The argument $info is a |
---|
| 97 | # hash reference set up in MAIN. The following environment variables are |
---|
| 98 | # used, where * is the source file type (F for Fortran, and C for C/C++): |
---|
| 99 | # |
---|
| 100 | # *C - compiler command |
---|
| 101 | # *C_OUTPUT - *C option to specify the name of the output file |
---|
| 102 | # *C_DEFINE - *C option to declare a pre-processor def |
---|
| 103 | # *C_INCLUDE - *C option to declare an include directory |
---|
| 104 | # *C_MODSEARCH- *C option to declare a module search directory |
---|
| 105 | # *C_COMPILE - *C option to ask the compiler to perform compile only |
---|
| 106 | # *CFLAGS - *C user options |
---|
| 107 | # *PPKEYS - list of pre-processor defs (may have sub-package suffix) |
---|
| 108 | # FCM_VERBOSE - verbose level |
---|
| 109 | # FCM_OBJDIR - destination directory of object file |
---|
| 110 | # FCM_TMPDIR - temporary destination directory of object file |
---|
| 111 | # ------------------------------------------------------------------------------ |
---|
| 112 | |
---|
| 113 | sub compile { |
---|
| 114 | my $info = shift; |
---|
| 115 | |
---|
| 116 | # Verbose mode |
---|
| 117 | my $verbose = &get_env ('FCM_VERBOSE'); |
---|
| 118 | $verbose = 1 unless defined ($verbose); |
---|
| 119 | |
---|
| 120 | my @command = (); |
---|
| 121 | |
---|
| 122 | # Guess file type for backward compatibility |
---|
| 123 | my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC}); |
---|
| 124 | |
---|
| 125 | # Compiler |
---|
| 126 | push @command, &get_env ($type . 'C', 1); |
---|
| 127 | |
---|
| 128 | # Compile output target (typical -o option) |
---|
| 129 | push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET}; |
---|
| 130 | |
---|
| 131 | # Pre-processor definition macros |
---|
| 132 | if ($info->{REQUIREPP}) { |
---|
| 133 | my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS'); |
---|
| 134 | my $defopt = &get_env ($type . 'C_DEFINE', 1); |
---|
| 135 | |
---|
| 136 | push @command, (map {$defopt . $_} @ppkeys); |
---|
| 137 | } |
---|
| 138 | |
---|
| 139 | # Include search path |
---|
| 140 | my $incopt = &get_env ($type . 'C_INCLUDE', 1); |
---|
| 141 | my @incpath = split /:/, &get_env ('FCM_INCPATH'); |
---|
| 142 | push @command, (map {$incopt . $_} @incpath); |
---|
| 143 | |
---|
| 144 | # Compiled module search path |
---|
| 145 | my $modopt = &get_env ($type . 'C_MODSEARCH'); |
---|
| 146 | if ($modopt) { |
---|
| 147 | push @command, (map {$modopt . $_} @incpath); |
---|
| 148 | } |
---|
| 149 | |
---|
| 150 | # Other compiler flags |
---|
| 151 | my $flags = &select_flags ($info, $type . 'FLAGS'); |
---|
| 152 | push @command, $flags if $flags; |
---|
| 153 | |
---|
| 154 | my $compile_only = &get_env ($type . 'C_COMPILE'); |
---|
| 155 | if ($flags !~ /(?:^|\s)$compile_only\b/) { |
---|
| 156 | push @command, &get_env ($type . 'C_COMPILE'); |
---|
| 157 | } |
---|
| 158 | |
---|
| 159 | # Name of source file |
---|
| 160 | push @command, $info->{SRC}; |
---|
| 161 | |
---|
| 162 | # Execute command |
---|
| 163 | my $objdir = &get_env ('FCM_OBJDIR', 1); |
---|
| 164 | my $tmpdir = &get_env ('FCM_TMPDIR', 1); |
---|
| 165 | chdir $tmpdir; |
---|
| 166 | |
---|
| 167 | my $command = join ' ', @command; |
---|
| 168 | if ($verbose > 1) { |
---|
| 169 | print 'cd ', $tmpdir, "\n"; |
---|
| 170 | print ×tamp_command ($command, 'Start'); |
---|
| 171 | |
---|
| 172 | } elsif ($verbose) { |
---|
| 173 | print $command, "\n"; |
---|
| 174 | } |
---|
| 175 | |
---|
| 176 | my $rc = system $command; |
---|
| 177 | |
---|
| 178 | print ×tamp_command ($command, 'End ') if $verbose > 1; |
---|
| 179 | |
---|
| 180 | # Move temporary output to correct location on success |
---|
| 181 | # Otherwise, remove temporary output |
---|
| 182 | if ($rc) { # error |
---|
| 183 | unlink $info->{TARGET}; |
---|
| 184 | |
---|
| 185 | } else { # success |
---|
| 186 | print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1; |
---|
| 187 | rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET}); |
---|
| 188 | } |
---|
| 189 | |
---|
| 190 | # Move any Fortran module definition files to the INC directory |
---|
| 191 | my @modfiles = <*.mod *.MOD>; |
---|
| 192 | for my $file (@modfiles) { |
---|
| 193 | rename $file, &catfile ($incpath[0], $file); |
---|
| 194 | } |
---|
| 195 | |
---|
| 196 | return $rc; |
---|
| 197 | } |
---|
| 198 | |
---|
| 199 | # ------------------------------------------------------------------------------ |
---|
| 200 | # SYNOPSIS |
---|
| 201 | # $rc = &load (\%info); |
---|
| 202 | # |
---|
| 203 | # DESCRIPTION |
---|
| 204 | # This method invokes the correct loader with the correct options to link |
---|
| 205 | # the main program object into an executable. The argument $info is a hash |
---|
| 206 | # reference set up in MAIN. The following environment variables are used: |
---|
| 207 | # |
---|
| 208 | # LD - * linker command |
---|
| 209 | # LD_OUTPUT - LD option to specify the name of the output file |
---|
| 210 | # LD_LIBSEARCH - LD option to declare a directory in the library search path |
---|
| 211 | # LD_LIBLINK - LD option to declare an object library |
---|
| 212 | # LDFLAGS - LD user options |
---|
| 213 | # FCM_VERBOSE - verbose level |
---|
| 214 | # FCM_LIBDIR - destination directory of object libraries |
---|
| 215 | # FCM_OBJDIR - destination directory of object files |
---|
| 216 | # FCM_BINDIR - destination directory of executable file |
---|
| 217 | # FCM_TMPDIR - temporary destination directory of executable file |
---|
| 218 | # |
---|
| 219 | # * If LD is not set, it will attempt to guess the file type and use the |
---|
| 220 | # compiler as the linker. |
---|
| 221 | # ------------------------------------------------------------------------------ |
---|
| 222 | |
---|
| 223 | sub load { |
---|
| 224 | my $info = shift; |
---|
| 225 | |
---|
| 226 | my $rc = 0; |
---|
| 227 | |
---|
| 228 | # Verbose mode |
---|
| 229 | my $verbose = &get_env ('FCM_VERBOSE'); |
---|
| 230 | $verbose = 1 unless defined ($verbose); |
---|
| 231 | |
---|
| 232 | # Create temporary object library |
---|
| 233 | (my $name = $info->{TARGET}) =~ s/\.\S+$//; |
---|
| 234 | my $libname = '__fcm__' . $name; |
---|
| 235 | my $lib = 'lib' . $libname . '.a'; |
---|
| 236 | my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib); |
---|
| 237 | $rc = &archive ({TARGET => $lib}); |
---|
| 238 | |
---|
| 239 | unless ($rc) { |
---|
| 240 | my @command = (); |
---|
| 241 | |
---|
| 242 | # Linker |
---|
| 243 | my $ld = &select_flags ($info, 'LD'); |
---|
| 244 | if (not $ld) { |
---|
| 245 | # Guess file type for backward compatibility |
---|
| 246 | my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC}); |
---|
| 247 | $ld = &get_env ($type . 'C', 1); |
---|
| 248 | } |
---|
| 249 | push @command, $ld; |
---|
| 250 | |
---|
| 251 | # Linker output target (typical -o option) |
---|
| 252 | push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET}; |
---|
| 253 | |
---|
| 254 | # Name of main object file |
---|
| 255 | my $mainobj = (basename ($info->{SRC}) eq $info->{SRC}) |
---|
| 256 | ? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC}) |
---|
| 257 | : $info->{SRC}; |
---|
| 258 | push @command, $mainobj; |
---|
| 259 | |
---|
| 260 | # Link with Fortran BLOCKDATA objects if necessary |
---|
| 261 | if (@{ $info->{BLOCKDATA} }) { |
---|
| 262 | my @blockdata = @{ $info->{BLOCKDATA} }; |
---|
| 263 | my @objpath = split /:/, &get_env ('FCM_OBJPATH'); |
---|
| 264 | |
---|
| 265 | # Search each BLOCKDATA object file from the object search path |
---|
| 266 | for my $file (@blockdata) { |
---|
| 267 | for my $dir (@objpath) { |
---|
| 268 | my $full = catfile ($dir, $file); |
---|
| 269 | |
---|
| 270 | if (-r $full) { |
---|
| 271 | $file = $full; |
---|
| 272 | last; |
---|
| 273 | } |
---|
| 274 | } |
---|
| 275 | |
---|
| 276 | push @command, $file; |
---|
| 277 | } |
---|
| 278 | } |
---|
| 279 | |
---|
| 280 | # Library search path |
---|
| 281 | my $libopt = &get_env ('LD_LIBSEARCH', 1); |
---|
| 282 | my @libpath = split /:/, &get_env ('FCM_LIBPATH'); |
---|
| 283 | push @command, (map {$libopt . $_} @libpath); |
---|
| 284 | |
---|
| 285 | # Link with temporary object library if it exists |
---|
| 286 | push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile; |
---|
| 287 | |
---|
| 288 | # Other linker flags |
---|
| 289 | my $flags = &select_flags ($info, 'LDFLAGS'); |
---|
| 290 | push @command, $flags; |
---|
| 291 | |
---|
| 292 | # Execute command |
---|
| 293 | my $tmpdir = &get_env ('FCM_TMPDIR', 1); |
---|
| 294 | my $bindir = &get_env ('FCM_BINDIR', 1); |
---|
| 295 | chdir $tmpdir; |
---|
| 296 | |
---|
| 297 | my $command = join ' ', @command; |
---|
| 298 | if ($verbose > 1) { |
---|
| 299 | print 'cd ', $tmpdir, "\n"; |
---|
| 300 | print ×tamp_command ($command, 'Start'); |
---|
| 301 | |
---|
| 302 | } elsif ($verbose) { |
---|
| 303 | print $command, "\n"; |
---|
| 304 | } |
---|
| 305 | |
---|
| 306 | $rc = system $command; |
---|
| 307 | |
---|
| 308 | print ×tamp_command ($command, 'End ') if $verbose > 1; |
---|
| 309 | |
---|
| 310 | # Move temporary output to correct location on success |
---|
| 311 | # Otherwise, remove temporary output |
---|
| 312 | if ($rc) { # error |
---|
| 313 | unlink $info->{TARGET}; |
---|
| 314 | |
---|
| 315 | } else { # success |
---|
| 316 | print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1; |
---|
| 317 | rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET}); |
---|
| 318 | } |
---|
| 319 | } |
---|
| 320 | |
---|
| 321 | # Remove the temporary object library |
---|
| 322 | unlink $libfile if -f $libfile; |
---|
| 323 | |
---|
| 324 | return $rc; |
---|
| 325 | } |
---|
| 326 | |
---|
| 327 | # ------------------------------------------------------------------------------ |
---|
| 328 | # SYNOPSIS |
---|
| 329 | # $rc = &archive (\%info); |
---|
| 330 | # |
---|
| 331 | # DESCRIPTION |
---|
| 332 | # This method invokes the library archiver to create an object library. The |
---|
| 333 | # argument $info is a hash reference set up in MAIN. The following |
---|
| 334 | # environment variables are used: |
---|
| 335 | # |
---|
| 336 | # AR - archiver command |
---|
| 337 | # ARFLAGS - AR options to update/create an object library |
---|
| 338 | # FCM_VERBOSE - verbose level |
---|
| 339 | # FCM_LIBDIR - destination directory of object libraries |
---|
| 340 | # FCM_OBJPATH - search path of object files |
---|
| 341 | # FCM_OBJDIR - destination directory of object files |
---|
| 342 | # FCM_TMPDIR - temporary destination directory of executable file |
---|
| 343 | # ------------------------------------------------------------------------------ |
---|
| 344 | |
---|
| 345 | sub archive { |
---|
| 346 | my $info = shift; |
---|
| 347 | |
---|
| 348 | my $rc = 0; |
---|
| 349 | |
---|
| 350 | # Verbose mode |
---|
| 351 | my $verbose = &get_env ('FCM_VERBOSE'); |
---|
| 352 | $verbose = 1 unless defined ($verbose); |
---|
| 353 | |
---|
| 354 | # Set up the archive command |
---|
| 355 | my $lib = &basename ($info->{TARGET}); |
---|
| 356 | my $tmplib = &catfile (&get_env ('FCM_TMPDIR', 1), $lib); |
---|
| 357 | my @ar_cmd = (); |
---|
| 358 | push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1)); |
---|
| 359 | push @ar_cmd, $tmplib; |
---|
| 360 | |
---|
| 361 | # Get object directories and their files |
---|
| 362 | my %objdir; |
---|
| 363 | if (exists $info->{OBJECTS}) { |
---|
| 364 | # List of objects set in the argument, sort into directory/file list |
---|
| 365 | for my $name (@{ $info->{OBJECTS} }) { |
---|
| 366 | my $dir = (&dirname ($name) eq '.') |
---|
| 367 | ? &get_env ('FCM_OBJDIR', 1) : &dirname ($name); |
---|
| 368 | $objdir{$dir}{&basename ($name)} = 1; |
---|
| 369 | } |
---|
| 370 | |
---|
| 371 | } else { |
---|
| 372 | # Objects not listed in argument, search object path for all files |
---|
| 373 | my @objpath = split /:/, &get_env ('FCM_OBJPATH', 1); |
---|
| 374 | my %objbase = (); |
---|
| 375 | |
---|
| 376 | # Get registered objects into a hash (keys = objects, values = 1) |
---|
| 377 | my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS')); |
---|
| 378 | |
---|
| 379 | # Seach object path for all files |
---|
| 380 | for my $dir (@objpath) { |
---|
| 381 | next unless -d $dir; |
---|
| 382 | |
---|
| 383 | chdir $dir; |
---|
| 384 | |
---|
| 385 | # Use all files from each directory in the object search path |
---|
| 386 | for ((glob ('*'))) { |
---|
| 387 | next unless exists $objects{$_}; # consider registered objects only |
---|
| 388 | $objdir{$dir}{$_} = 1 unless exists $objbase{$_}; |
---|
| 389 | $objbase{$_} = 1; |
---|
| 390 | } |
---|
| 391 | } |
---|
| 392 | } |
---|
| 393 | |
---|
| 394 | for my $dir (sort keys %objdir) { |
---|
| 395 | next unless -d $dir; |
---|
| 396 | |
---|
| 397 | # Go to each object directory and executes the library archive command |
---|
| 398 | chdir $dir; |
---|
| 399 | my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} }); |
---|
| 400 | |
---|
| 401 | if ($verbose > 1) { |
---|
| 402 | print 'cd ', $dir, "\n"; |
---|
| 403 | print ×tamp_command ($command, 'Start'); |
---|
| 404 | |
---|
| 405 | } else { |
---|
| 406 | print $command, "\n" if exists $info->{OBJECTS}; |
---|
| 407 | } |
---|
| 408 | |
---|
| 409 | $rc = system $command; |
---|
| 410 | |
---|
| 411 | print ×tamp_command ($command, 'End ') |
---|
| 412 | if $verbose > 1; |
---|
| 413 | last if $rc; |
---|
| 414 | } |
---|
| 415 | |
---|
| 416 | # Move temporary output to correct location on success |
---|
| 417 | # Otherwise, remove temporary output |
---|
| 418 | if ($rc) { # error |
---|
| 419 | unlink $tmplib; |
---|
| 420 | |
---|
| 421 | } else { # success |
---|
| 422 | my $libdir = &get_env ('FCM_LIBDIR', 1); |
---|
| 423 | |
---|
| 424 | print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1; |
---|
| 425 | rename $tmplib, &catfile ($libdir, $lib); |
---|
| 426 | } |
---|
| 427 | |
---|
| 428 | return $rc; |
---|
| 429 | } |
---|
| 430 | |
---|
| 431 | # ------------------------------------------------------------------------------ |
---|
| 432 | # SYNOPSIS |
---|
| 433 | # $type = &guess_file_type ($filename); |
---|
| 434 | # |
---|
| 435 | # DESCRIPTION |
---|
| 436 | # This function attempts to guess the file type by looking at the extension |
---|
| 437 | # of the $filename. Only C and Fortran at the moment. |
---|
| 438 | # ------------------------------------------------------------------------------ |
---|
| 439 | |
---|
| 440 | sub guess_file_type { |
---|
| 441 | return (($_[0] =~ /\.c(\w+)?$/i) ? 'C' : 'F'); |
---|
| 442 | } |
---|
| 443 | |
---|
| 444 | # ------------------------------------------------------------------------------ |
---|
| 445 | # SYNOPSIS |
---|
| 446 | # $flags = &select_flags (\%info, $set); |
---|
| 447 | # |
---|
| 448 | # DESCRIPTION |
---|
| 449 | # This function selects the correct compiler/linker flags for the current |
---|
| 450 | # sub-package from the environment variable prefix $set. The argument $info |
---|
| 451 | # is a hash reference set up in MAIN. |
---|
| 452 | # ------------------------------------------------------------------------------ |
---|
| 453 | |
---|
| 454 | sub select_flags { |
---|
| 455 | my ($info, $set) = @_; |
---|
| 456 | |
---|
| 457 | my $srcbase = &basename ($info->{SRC}); |
---|
| 458 | my @names = ($set); |
---|
| 459 | push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcbase); |
---|
| 460 | |
---|
| 461 | my $string = ''; |
---|
| 462 | for my $i (reverse (0 .. $#names)) { |
---|
| 463 | my $var = &get_env (join ('__', (@names[0 .. $i]))); |
---|
| 464 | |
---|
| 465 | $var = &get_env (join ('__', (@names[0 .. $i]))) |
---|
| 466 | if (not defined ($var)) and $i and $names[-1] =~ s/\.[^\.]+$//; |
---|
| 467 | |
---|
| 468 | next unless defined $var; |
---|
| 469 | $string = $var; |
---|
| 470 | last; |
---|
| 471 | } |
---|
| 472 | |
---|
| 473 | return $string; |
---|
| 474 | } |
---|
| 475 | |
---|
| 476 | # ------------------------------------------------------------------------------ |
---|
| 477 | # SYNOPSIS |
---|
| 478 | # $variable = &get_env ($name); |
---|
| 479 | # $variable = &get_env ($name, $compulsory); |
---|
| 480 | # |
---|
| 481 | # DESCRIPTION |
---|
| 482 | # This internal method gets a variable from $ENV{$name}. If $compulsory is |
---|
| 483 | # set to true, it throws an error if the variable is a not set or is an empty |
---|
| 484 | # string. Otherwise, it returns C<undef> if the variable is not set. |
---|
| 485 | # ------------------------------------------------------------------------------ |
---|
| 486 | |
---|
| 487 | sub get_env { |
---|
| 488 | (my $name, my $compulsory) = @_; |
---|
| 489 | my $string; |
---|
| 490 | |
---|
| 491 | if ($name =~ /^\w+$/) { |
---|
| 492 | # $name contains only word characters, variable is exported normally |
---|
| 493 | die 'The environment variable "', $name, '" must be set, abort' |
---|
| 494 | if $compulsory and not exists $ENV{$name}; |
---|
| 495 | |
---|
| 496 | $string = exists $ENV{$name} ? $ENV{$name} : undef; |
---|
| 497 | |
---|
| 498 | } else { |
---|
| 499 | # $name contains unusual characters |
---|
| 500 | die 'The environment variable "', $name, '" must be set, abort' |
---|
| 501 | if $compulsory and not exists $unusual_tool_name{$name}; |
---|
| 502 | |
---|
| 503 | $string = exists $unusual_tool_name{$name} |
---|
| 504 | ? $unusual_tool_name{$name} : undef; |
---|
| 505 | } |
---|
| 506 | |
---|
| 507 | return $string; |
---|
| 508 | } |
---|
| 509 | |
---|
| 510 | # ------------------------------------------------------------------------------ |
---|
| 511 | # SYNOPSIS |
---|
| 512 | # $path = &catfile (@paths); |
---|
| 513 | # |
---|
| 514 | # DESCRIPTION |
---|
| 515 | # This is a local implementation of what is in the File::Spec module. |
---|
| 516 | # ------------------------------------------------------------------------------ |
---|
| 517 | |
---|
| 518 | sub catfile { |
---|
| 519 | my @names = split (m!/!, join ('/', @_)); |
---|
| 520 | my $path = shift @names; |
---|
| 521 | |
---|
| 522 | for my $name (@names) { |
---|
| 523 | $path .= '/' . $name if $name; |
---|
| 524 | } |
---|
| 525 | |
---|
| 526 | return $path; |
---|
| 527 | } |
---|
| 528 | |
---|
| 529 | # ------------------------------------------------------------------------------ |
---|
| 530 | # SYNOPSIS |
---|
| 531 | # $basename = &basename ($path); |
---|
| 532 | # |
---|
| 533 | # DESCRIPTION |
---|
| 534 | # This is a local implementation of what is in the File::Basename module. |
---|
| 535 | # ------------------------------------------------------------------------------ |
---|
| 536 | |
---|
| 537 | sub basename { |
---|
| 538 | my $name = $_[0]; |
---|
| 539 | |
---|
| 540 | $name =~ s{/*$}{}; # remove trailing slashes |
---|
| 541 | |
---|
| 542 | if ($name =~ m#.*/([^/]+)$#) { |
---|
| 543 | return $1; |
---|
| 544 | |
---|
| 545 | } else { |
---|
| 546 | return $name; |
---|
| 547 | } |
---|
| 548 | } |
---|
| 549 | |
---|
| 550 | # ------------------------------------------------------------------------------ |
---|
| 551 | # SYNOPSIS |
---|
| 552 | # $dirname = &dirname ($path); |
---|
| 553 | # |
---|
| 554 | # DESCRIPTION |
---|
| 555 | # This is a local implementation of what is in the File::Basename module. |
---|
| 556 | # ------------------------------------------------------------------------------ |
---|
| 557 | |
---|
| 558 | sub dirname { |
---|
| 559 | my $name = $_[0]; |
---|
| 560 | |
---|
| 561 | if ($name =~ m#^/+$#) { |
---|
| 562 | return '/'; # dirname of root is root |
---|
| 563 | |
---|
| 564 | } else { |
---|
| 565 | $name =~ s{/*$}{}; # remove trailing slashes |
---|
| 566 | |
---|
| 567 | if ($name =~ m#^(.*)/[^/]+$#) { |
---|
| 568 | my $dir = $1; |
---|
| 569 | $dir =~ s{/*$}{}; # remove trailing slashes |
---|
| 570 | return $dir; |
---|
| 571 | |
---|
| 572 | } else { |
---|
| 573 | return '.'; |
---|
| 574 | } |
---|
| 575 | } |
---|
| 576 | } |
---|
| 577 | |
---|
| 578 | # ------------------------------------------------------------------------------ |
---|
| 579 | |
---|
| 580 | __END__ |
---|
| 581 | |
---|
| 582 | =head1 NAME |
---|
| 583 | |
---|
| 584 | fcm_internal |
---|
| 585 | |
---|
| 586 | =head1 SYNOPSIS |
---|
| 587 | |
---|
| 588 | fcm_internal SUBCOMMAND ARGS |
---|
| 589 | |
---|
| 590 | =head1 DESCRIPTION |
---|
| 591 | |
---|
| 592 | The fcm_internal command is a frontend for some of the internal commands of |
---|
| 593 | the FCM build system. The subcommand can be "compile", "load" or "archive" |
---|
| 594 | for invoking the compiler, loader and library archiver respectively. If |
---|
| 595 | "compile" or "load" is specified, it can be suffixed with ":TYPE" to |
---|
| 596 | specify the nature of the source file. If TYPE is not specified, it is set |
---|
| 597 | to C if the file extension begins with ".c". For all other file types, it |
---|
| 598 | is set to F (for Fortran source). For compile and load, the other arguments |
---|
| 599 | are 1) the name of the container package of the source file, 2) the path to |
---|
| 600 | the source file and 3) the target name after compiling or loading the |
---|
| 601 | source file. For compile, the 4th argument is a flag to indicate whether |
---|
| 602 | pre-processing is required for compiling the source file. For load, the |
---|
| 603 | 4th and the rest of the arguments is a list of object files that cannot be |
---|
| 604 | archived into the temporary load library and must be linked into the target |
---|
| 605 | through the linker command. (E.g. Fortran BLOCKDATA program units must be |
---|
| 606 | linked this way.) If archive is specified, the first argument should be the |
---|
| 607 | name of the library archive target and the rest should be the object files |
---|
| 608 | to be included in the archive. This command is invoked via the build system |
---|
| 609 | and should never be called directly by the user. |
---|
| 610 | |
---|
| 611 | =head1 COPYRIGHT |
---|
| 612 | |
---|
| 613 | (C) Crown copyright Met Office. All rights reserved. |
---|
| 614 | |
---|
| 615 | =cut |
---|