IPP Software Navigation Tools IPP Links Communication Pan-STARRS Links

Changeset 17667


Ignore:
Timestamp:
May 13, 2008, 4:06:02 PM (18 years ago)
Author:
jhoblitt
Message:

expand tabs

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/PS-IPP-Config/lib/PS/IPP/Config.pm

    r17664 r17667  
    11# Copyright (c) 2006  Paul Price, Joshua Hoblitt
    22#
    3 # $Id: Config.pm,v 1.84 2008-05-14 01:52:31 bills Exp $
     3# $Id: Config.pm,v 1.85 2008-05-14 02:06:02 jhoblitt Exp $
    44
    55package PS::IPP::Config;
    … …  
    2121
    2222our @EXPORT_OK = qw(
    23                     $PS_EXIT_SUCCESS
    24                     $PS_EXIT_UNKNOWN_ERROR
    25                     $PS_EXIT_SYS_ERROR
    26                     $PS_EXIT_CONFIG_ERROR
    27                     $PS_EXIT_PROG_ERROR
    28                     $PS_EXIT_DATA_ERROR
    29                     $PS_EXIT_TIMEOUT_ERROR
    30                     metadataLookupStr
    31                     metadataLookupMD
    32                     metadataLookupBool
    33                     caturi
    34                     file_scheme
    35                     );
     23                    $PS_EXIT_SUCCESS
     24                    $PS_EXIT_UNKNOWN_ERROR
     25                    $PS_EXIT_SYS_ERROR
     26                    $PS_EXIT_CONFIG_ERROR
     27                    $PS_EXIT_PROG_ERROR
     28                    $PS_EXIT_DATA_ERROR
     29                    $PS_EXIT_TIMEOUT_ERROR
     30                    metadataLookupStr
     31                    metadataLookupMD
     32                    metadataLookupBool
     33                    caturi
     34                    file_scheme
     35                    );
    3636our %EXPORT_TAGS = (standard => [@EXPORT_OK]);
    3737
    … …  
    4545
    4646our $parser = PS::IPP::Metadata::Config->new; # Metadata parser
    47 $parser->overwrite(0);          # Turn off overwrite
     47$parser->overwrite(0);                # Turn off overwrite
    4848
    4949#$::RD_TRACE = 1;
    … …  
    5353# Given a parsed metadata, parse it into an array of hashes
    5454sub new {
    55     my $class = shift;          # Class name
    56     my $camera = shift;         # Camera name
     55    my $class = shift;                # Class name
     56    my $camera = shift;                # Camera name
    5757
    5858    unless (defined $class) {
    59         carp "Programming error";
    60         exit($PS_EXIT_PROG_ERROR);
     59        carp "Programming error";
     60        exit($PS_EXIT_PROG_ERROR);
    6161    }
    6262
    6363    # Get location of ipprc file
    64     my $name;                   # Name of ipprc file
     64    my $name;                        # Name of ipprc file
    6565    GetOptions( 'site=s' => \$name );
    6666    $name = $ENV{IPPRC} if not defined $name;
    6767    if (not defined $name and defined $ENV{HOME}) {
    68         $name = $ENV{HOME} . '/.ipprc';
    69     }
    70 
    71     my $file;                   # File handle
     68        $name = $ENV{HOME} . '/.ipprc';
     69    }
     70
     71    my $file;                        # File handle
    7272    unless (open $file, $name) {
    73         carp "Unable to open ipprc file $name: $!";
    74         exit($PS_EXIT_CONFIG_ERROR);
    75     }
    76     my @contents = <$file>;     # Contents of the ipprc file
     73        carp "Unable to open ipprc file $name: $!";
     74        exit($PS_EXIT_CONFIG_ERROR);
     75    }
     76    my @contents = <$file>;        # Contents of the ipprc file
    7777    close $file;
    7878
    … …  
    8181    my $path = _interpolate_env(metadataLookupStr($mdc, 'PATH')); # The path
    8282    unless (defined $path) {
    83         carp "PATH is not set in $name\n";
    84         exit($PS_EXIT_CONFIG_ERROR);
     83        carp "PATH is not set in $name\n";
     84        exit($PS_EXIT_CONFIG_ERROR);
    8585    }
    8686
    … …  
    8888
    8989    my $self = {
    90         path => $path,          # Path
    91         camera => undef,        # Camera configuration
    92         filerules => undef,     # File rules from the camera configuration
    93         rejection => undef,     # Rejection data
    94         reductionClasses => undef, # Reduction class definitions
    95         _userConfig => $mdc,    # The top-level user configuration
    96         _siteConfig => undef,   # The site configuration (from _userConfig)
    97         _systemConfig => undef  # The system configuration (from _userConfig)
    98         };
     90        path => $path,                # Path
     91        camera => undef,        # Camera configuration
     92        filerules => undef,        # File rules from the camera configuration
     93        rejection => undef,        # Rejection data
     94        reductionClasses => undef, # Reduction class definitions
     95        _userConfig => $mdc,        # The top-level user configuration
     96        _siteConfig => undef,        # The site configuration (from _userConfig)
     97        _systemConfig => undef        # The system configuration (from _userConfig)
     98        };
    9999    bless $self, $class;
    100100
    … …  
    110110sub _find_config
    111111{
    112     my $self = shift;           # Configuration object
    113     my $filename = shift;       # File name to find
     112    my $self = shift;                # Configuration object
     113    my $filename = shift;        # File name to find
    114114
    115115    my @path = split /:/, $self->{path}; # List of paths to try
    116     my $found = 0;                      # Found it?
     116    my $found = 0;                        # Found it?
    117117    my $realfile;
    118118    my $tries = 0;
    119119    while (not $found) {
    120         ## try a second time
    121         foreach my $path (@path) {
    122             $realfile = File::Spec->rel2abs( $filename, $path );
    123             if ($tries) {
    124                 print "re-trying ($tries): filename: $filename, path: $path -> ";
    125                 print "test: $realfile\n";
    126             }
    127             if (-f $realfile) {
    128                 $found = 1;
    129                 return $realfile;
    130             }
    131         }
    132         if (not $found) {
    133             $tries ++;
    134             if ($tries > 4) {
    135                 unless ($found) {
    136                     carp "Unable to find camera configuration file $filename\n";
    137                     exit($PS_EXIT_CONFIG_ERROR);
    138                 }
    139             }
    140             ## try again after a moment?
    141             ## system ("df");
    142             select(undef, undef, undef, 0.25);
    143         }
     120        ## try a second time
     121        foreach my $path (@path) {
     122            $realfile = File::Spec->rel2abs( $filename, $path );
     123            if ($tries) {
     124                print "re-trying ($tries): filename: $filename, path: $path -> ";
     125                print "test: $realfile\n";
     126            }
     127            if (-f $realfile) {
     128                $found = 1;
     129                return $realfile;
     130            }
     131        }
     132        if (not $found) {
     133            $tries ++;
     134            if ($tries > 4) {
     135                unless ($found) {
     136                    carp "Unable to find camera configuration file $filename\n";
     137                    exit($PS_EXIT_CONFIG_ERROR);
     138                }
     139            }
     140            ## try again after a moment?
     141            ## system ("df");
     142            select(undef, undef, undef, 0.25);
     143        }
    144144    }
    145145
    … …  
    151151sub load_site
    152152{
    153     my $self = shift;           # Configuration object
     153    my $self = shift;                # Configuration object
    154154
    155155    my $i = 0;
    156156
    157157    unless (defined $self) {
    158         carp "Programming error";
    159         exit($PS_EXIT_PROG_ERROR);
     158        carp "Programming error";
     159        exit($PS_EXIT_PROG_ERROR);
    160160    }
    161161
    162162    my $filename = metadataLookupStr($self->{_userConfig}, 'SITE'); # Site config file
    163163    unless (defined $filename) {
    164         carp "Unable to find site configuration file\n";
    165         exit($PS_EXIT_CONFIG_ERROR);
     164        carp "Unable to find site configuration file\n";
     165        exit($PS_EXIT_CONFIG_ERROR);
    166166    }
    167167
    … …  
    169169
    170170    # Read the file
    171     my $file;                   # File handle
     171    my $file;                        # File handle
    172172    unless (open $file, $realfile) {
    173         carp "Unable to open site configuration file $realfile: $!";
    174         exit($PS_EXIT_CONFIG_ERROR);
     173        carp "Unable to open site configuration file $realfile: $!";
     174        exit($PS_EXIT_CONFIG_ERROR);
    175175    }
    176176
    … …  
    180180
    181181    unless (defined $self->{_siteConfig}) {
    182         carp "Failure to parse the site configuration file $realfile";
    183         exit($PS_EXIT_CONFIG_ERROR);
     182        carp "Failure to parse the site configuration file $realfile";
     183        exit($PS_EXIT_CONFIG_ERROR);
    184184    }
    185185
    … …  
    190190sub load_system
    191191{
    192     my $self = shift;           # Configuration object
     192    my $self = shift;                # Configuration object
    193193
    194194    unless (defined $self) {
    195         carp "Programming error";
    196         exit($PS_EXIT_PROG_ERROR);
     195        carp "Programming error";
     196        exit($PS_EXIT_PROG_ERROR);
    197197    }
    198198
    199199    my $filename = metadataLookupStr($self->{_userConfig}, 'SYSTEM'); # System config file
    200200    unless (defined $filename) {
    201         carp "Unable to find system configuration file\n";
    202         exit($PS_EXIT_CONFIG_ERROR);
     201        carp "Unable to find system configuration file\n";
     202        exit($PS_EXIT_CONFIG_ERROR);
    203203    }
    204204
    … …  
    206206
    207207    # Read the file
    208     my $file;                   # File handle
     208    my $file;                        # File handle
    209209    unless (open $file, $realfile) {
    210         carp "Unable to open system configuration file $realfile: $!";
    211         exit($PS_EXIT_CONFIG_ERROR);
     210        carp "Unable to open system configuration file $realfile: $!";
     211        exit($PS_EXIT_CONFIG_ERROR);
    212212    }
    213213    my @contents = <$file>;
    … …  
    216216
    217217    unless (defined $self->{_systemConfig}) {
    218         carp "Failure to define system configuration";
    219         exit($PS_EXIT_CONFIG_ERROR);
     218        carp "Failure to define system configuration";
     219        exit($PS_EXIT_CONFIG_ERROR);
    220220    }
    221221
    … …  
    227227sub define_camera
    228228{
    229     my $self = shift;           # Configuration object
    230     my $name = shift;           # Camera name
     229    my $self = shift;                # Configuration object
     230    my $name = shift;                # Camera name
    231231
    232232    unless (defined $self and defined $name) {
    233         carp "Programming error";
    234         exit($PS_EXIT_PROG_ERROR);
     233        carp "Programming error";
     234        exit($PS_EXIT_PROG_ERROR);
    235235    }
    236236
    … …  
    238238    my $filename = metadataLookupStr($camera_list, $name); # Filename of camera configuration
    239239    unless (defined $filename) {
    240         carp "Unable to find configuration file for camera $name\n";
    241         exit($PS_EXIT_CONFIG_ERROR);
     240        carp "Unable to find configuration file for camera $name\n";
     241        exit($PS_EXIT_CONFIG_ERROR);
    242242    }
    243243
    … …  
    245245
    246246    # Read the file
    247     my $file;                   # File handle
     247    my $file;                        # File handle
    248248    unless (open $file, $realfile) {
    249         carp "Unable to open camera configuration file $realfile: $!";
    250         exit($PS_EXIT_CONFIG_ERROR);
     249        carp "Unable to open camera configuration file $realfile: $!";
     250        exit($PS_EXIT_CONFIG_ERROR);
    251251    }
    252252    my @contents = <$file>;
    … …  
    256256
    257257    unless (defined $self->{camera}) {
    258         carp "Failure to define camera";
    259         exit($PS_EXIT_CONFIG_ERROR);
     258        carp "Failure to define camera";
     259        exit($PS_EXIT_CONFIG_ERROR);
    260260    }
    261261
    … …  
    267267sub file_scheme
    268268{
    269     my $name = shift;           # Filename for which to get the scheme
     269    my $name = shift;                # Filename for which to get the scheme
    270270    my ($scheme) = $name =~ /^(path|neb|file):/; # The scheme, e.g., file://, path://
    271271    # $scheme may be undef if the input doesn't contain one of the above recognised schemes
    … …  
    277277sub caturi
    278278{
    279     my $base = shift;           # Base name (might be "foo /foo path://SOMETHING" or "neb://SOMETHING")
    280     my @segments = @_;          # Path segments
     279    my $base = shift;                # Base name (might be "foo /foo path://SOMETHING" or "neb://SOMETHING")
     280    my @segments = @_;                # Path segments
    281281
    282282    carp "base is not inited" if not defined $base;
    … …  
    291291    # Remove leading and trailing slashes
    292292    foreach my $segment ( @segments ) {
    293         $segment =~ s|^/*||;
    294         $segment =~ s|/*$||;
     293        $segment =~ s|^/*||;
     294        $segment =~ s|/*$||;
    295295    }
    296296
    … …  
    298298    my $joined = join('/', @segments);
    299299    if (defined $scheme) {
    300         $joined = lc($scheme) . "://" . $joined;
     300        $joined = lc($scheme) . "://" . $joined;
    301301    } else {
    302         $joined = $root . $joined;
     302        $joined = $root . $joined;
    303303    }
    304304
    … …  
    309309sub datapath
    310310{
    311     my $self = shift;           # Configuration object
    312     my $name = shift;           # datapath name
     311    my $self = shift;                # Configuration object
     312    my $name = shift;                # datapath name
    313313
    314314    unless (defined $self and defined $name) {
    315         carp "Programming error";
    316         exit($PS_EXIT_PROG_ERROR);
     315        carp "Programming error";
     316        exit($PS_EXIT_PROG_ERROR);
    317317    }
    318318
    … …  
    320320    my $pathname = metadataLookupStr($path_list, $name); # Path of interest
    321321    unless (defined $pathname) {
    322         carp "Unable to find datapath $name\n" ;
    323         exit($PS_EXIT_CONFIG_ERROR);
     322        carp "Unable to find datapath $name\n" ;
     323        exit($PS_EXIT_CONFIG_ERROR);
    324324    }
    325325
    … …  
    330330sub _neb_start
    331331{
    332     my $self = shift;           # Configuration object
     332    my $self = shift;                # Configuration object
    333333
    334334    eval {
    335         require Nebulous::Client;
     335        require Nebulous::Client;
    336336    };
    337337    if ($@) {
    338         carp "Can't find Nebulous::Client.";
    339         exit($PS_EXIT_PROG_ERROR);
     338        carp "Can't find Nebulous::Client.";
     339        exit($PS_EXIT_PROG_ERROR);
    340340    }
    341341
    … …  
    344344    my $server = metadataLookupStr( $self->{_siteConfig}, 'NEB_SERVER' ); # Nebulous server
    345345    unless (defined $server) {
    346         carp "Unable to find NEB_SERVER in camera configuration file.";
    347         exit($PS_EXIT_CONFIG_ERROR);
     346        carp "Unable to find NEB_SERVER in camera configuration file.";
     347        exit($PS_EXIT_CONFIG_ERROR);
    348348    }
    349349
    350350    my $neb = Nebulous::Client->new( proxy => $server );
    351351    unless (defined $neb) {
    352         carp "Unable to find NEB_SERVER in camera configuration file.";
    353         exit($PS_EXIT_CONFIG_ERROR);
     352        carp "Unable to find NEB_SERVER in camera configuration file.";
     353        exit($PS_EXIT_CONFIG_ERROR);
    354354    }
    355355
    … …  
    362362sub file_resolve
    363363{
    364     my $self = shift;           # Configuration object
    365     my $name = shift;           # File name to check
    366     my $touch = shift;          # if $name is in nebulous instantiate it
     364    my $self = shift;                # Configuration object
     365    my $name = shift;                # File name to check
     366    my $touch = shift;                # if $name is in nebulous instantiate it
    367367
    368368    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
    … …  
    372372
    373373    if ($scheme eq 'neb') {
    374         $name =~ s|^neb:/*||;
    375         $self->_neb_start();
    376         my $neb = $self->{nebulous}; # Nebulous handle
     374        $name =~ s|^neb:/*||;
     375        $self->_neb_start();
     376        my $neb = $self->{nebulous}; # Nebulous handle
    377377        if ($touch) {
    378378            unless ($neb->stat( $name )) {
    … …  
    383383            }
    384384        }
    385         return $neb->find( $name );
     385        return $neb->find( $name );
    386386    }
    387387    if ($scheme eq 'path' or $scheme eq 'file') {
    388         # guaranteed to have a scheme (path:// or file://)
    389         return $self->convert_filename_absolute( $name );
     388        # guaranteed to have a scheme (path:// or file://)
     389        return $self->convert_filename_absolute( $name );
    390390    }
    391391
    … …  
    396396sub file_create_open
    397397{
    398     my $self = shift;           # Configuration object
    399     my $name = shift;           # File name to check
     398    my $self = shift;                # Configuration object
     399    my $name = shift;                # File name to check
    400400
    401401    $self->file_prepare( $name );
    … …  
    403403    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
    404404    if (defined $scheme) {
    405         $scheme = lc($scheme);
    406         if ($scheme eq 'neb') {
    407             $name =~ s|^neb:/*||;
    408             $self->_neb_start();
    409             return $self->{nebulous}->open_create( $name );
    410         }
    411         if ($scheme eq 'path' or $scheme eq 'file') {
    412             # guaranteed to have a scheme (path:// or file://)
    413             $name = $self->convert_filename_absolute( $name );
    414         }
     405        $scheme = lc($scheme);
     406        if ($scheme eq 'neb') {
     407            $name =~ s|^neb:/*||;
     408            $self->_neb_start();
     409            return $self->{nebulous}->open_create( $name );
     410        }
     411        if ($scheme eq 'path' or $scheme eq 'file') {
     412            # guaranteed to have a scheme (path:// or file://)
     413            $name = $self->convert_filename_absolute( $name );
     414        }
    415415    }
    416416
    417417    if (-f $name) {
    418         carp "Unable to create file $name --- file exists.";
    419         exit($PS_EXIT_SYS_ERROR);
     418        carp "Unable to create file $name --- file exists.";
     419        exit($PS_EXIT_SYS_ERROR);
    420420    }
    421421
    422422    my $fh;
    423423    unless (open $fh, '>', $name) {
    424         carp "Unable to create file $name --- $!";
    425         exit($PS_EXIT_SYS_ERROR);
     424        carp "Unable to create file $name --- $!";
     425        exit($PS_EXIT_SYS_ERROR);
    426426    }
    427427    return $fh;
    … …  
    431431sub file_create_append
    432432{
    433     my $self = shift;           # Configuration object
    434     my $name = shift;           # File name to check
     433    my $self = shift;                # Configuration object
     434    my $name = shift;                # File name to check
    435435
    436436    $self->file_prepare( $name );
    … …  
    438438    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
    439439    if (defined $scheme) {
    440         $scheme = lc($scheme);
    441         if ($scheme eq 'neb') {
    442             $name =~ s|^neb:/*||;
    443             $self->_neb_start();
    444             return $self->{nebulous}->open_create( $name );
    445         }
    446         if ($scheme eq 'path' or $scheme eq 'file') {
    447             # guaranteed to have a scheme (path:// or file://)
    448             $name = $self->convert_filename_absolute( $name );
    449         }
     440        $scheme = lc($scheme);
     441        if ($scheme eq 'neb') {
     442            $name =~ s|^neb:/*||;
     443            $self->_neb_start();
     444            return $self->{nebulous}->open_create( $name );
     445        }
     446        if ($scheme eq 'path' or $scheme eq 'file') {
     447            # guaranteed to have a scheme (path:// or file://)
     448            $name = $self->convert_filename_absolute( $name );
     449        }
    450450    }
    451451
    452452    my $fh;
    453453    unless (open $fh, '>>', $name) {
    454         carp "Unable to create file $name --- $!";
    455         exit($PS_EXIT_SYS_ERROR);
     454        carp "Unable to create file $name --- $!";
     455        exit($PS_EXIT_SYS_ERROR);
    456456    }
    457457    return $fh;
    … …  
    461461sub file_create
    462462{
    463     my $self = shift;           # Configuration object
    464     my $name = shift;           # File name to check
     463    my $self = shift;                # Configuration object
     464    my $name = shift;                # File name to check
    465465
    466466    $self->file_prepare( $name );
    … …  
    468468    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
    469469    if (defined $scheme and lc($scheme) eq 'neb') {
    470         $name =~ s|^neb:/*||;
    471         $self->_neb_start();
    472         $name = $self->{nebulous}->create( $name );
     470        $name =~ s|^neb:/*||;
     471        $self->_neb_start();
     472        $name = $self->{nebulous}->create( $name );
    473473    }
    474474
    … …  
    479479sub file_exists
    480480{
    481     my $self = shift;           # Configuration object
    482     my $name = shift;           # File name to check
     481    my $self = shift;                # Configuration object
     482    my $name = shift;                # File name to check
    483483
    484484    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
    485485    if (defined $scheme and lc($scheme) eq 'neb') {
    486         $name =~ s|^neb:/*||;
    487         $self->_neb_start();
    488         return (defined $self->{nebulous}->find_instances( $name ) ? 1 : 0);
     486        $name =~ s|^neb:/*||;
     487        $self->_neb_start();
     488        return (defined $self->{nebulous}->find_instances( $name ) ? 1 : 0);
    489489    }
    490490
    … …  
    495495sub file_copy
    496496{
    497     my $self = shift;           # Configuration object
    498     my $source = shift;         # Name of source file
    499     my $target = shift;         # Name of target file
     497    my $self = shift;                # Configuration object
     498    my $source = shift;                # Name of source file
     499    my $target = shift;                # Name of target file
    500500
    501501    $self->file_prepare( $target );
    … …  
    503503    my $scheme = file_scheme($target); # The scheme, e.g., file://, path://
    504504    if (defined $scheme and lc($scheme) eq 'neb') {
    505         $target =~ s|^neb:/*||;
    506         $self->_neb_start();
    507         $target = $self->{nebulous}->create( $target );
     505        $target =~ s|^neb:/*||;
     506        $self->_neb_start();
     507        $target = $self->{nebulous}->create( $target );
    508508    }
    509509    $target = $self->file_resolve( $target );
    … …  
    511511
    512512    system("cp $source $target") == 0 or (carp "Can't copy file $source to $target." and
    513                                           exit($PS_EXIT_DATA_ERROR));
     513                                          exit($PS_EXIT_DATA_ERROR));
    514514    return 1;
    515515}
    … …  
    518518sub _strip_filename
    519519{
    520     my $name = shift;           # File name of interest
     520    my $name = shift;                # File name of interest
    521521    $name =~ s|/[\w.-]*?$||;
    522522    return $name;
    … …  
    527527sub file_prepare
    528528{
    529     my $self = shift;           # Configuration object
    530     my $name = shift;           # File name for which to prepare
    531     my $workdir = shift;        # Working directory
    532     my $template = shift;       # Template filename from which to get working directory if
     529    my $self = shift;                # Configuration object
     530    my $name = shift;                # File name for which to prepare
     531    my $workdir = shift;        # Working directory
     532    my $template = shift;        # Template filename from which to get working directory if
    533533
    534534    if (defined $workdir) {
    535         $name = caturi( $workdir, $name );
     535        $name = caturi( $workdir, $name );
    536536    } elsif (defined $template) {
    537         # Take directory from template and apply to name
    538         my $dir = _strip_filename( $template );
    539         $name = caturi( $dir, $name );
     537        # Take directory from template and apply to name
     538        my $dir = _strip_filename( $template );
     539        $name = caturi( $dir, $name );
    540540    }
    541541
    … …  
    549549    my ( $vol, $dirs, $file ) = File::Spec->splitpath( $resolved );
    550550    unless (-d $dirs) {
    551         system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR));
     551        system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR));
    552552    }
    553553
    … …  
    559559sub outroot_prepare
    560560{
    561     my $self = shift;           # Configuration object
    562     my $outroot = shift;        # Working directory
     561    my $self = shift;                # Configuration object
     562    my $outroot = shift;        # Working directory
    563563
    564564    # outroot is a directory + fragement of a filename
    … …  
    573573    my ( $vol, $dirs, $file ) = File::Spec->splitpath( $resolved );
    574574    unless (-d $dirs) {
    575         system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR));
     575        system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR));
    576576    }
    577577
    … …  
    583583sub convert_filename_absolute
    584584{
    585     my $self = shift;           # Configuration object
    586     my $name = shift;           # raw name
     585    my $self = shift;                # Configuration object
     586    my $name = shift;                # raw name
    587587
    588588    unless (defined $self and defined $name) {
    589         carp "Programming error";
    590         exit($PS_EXIT_PROG_ERROR);
     589        carp "Programming error";
     590        exit($PS_EXIT_PROG_ERROR);
    591591    }
    592592
    … …  
    596596    ## if this is already an absolute path (/PATH/file), just return the path
    597597    unless (defined $scheme) {
    598         if ($name =~ m|^/|) { return $name; }
    599         # without a leading slash, this is an error
    600         carp "Relative file name provided: relative paths are not permitted.";
    601         exit($PS_EXIT_SYS_ERROR);
     598        if ($name =~ m|^/|) { return $name; }
     599        # without a leading slash, this is an error
     600        carp "Relative file name provided: relative paths are not permitted.";
     601        exit($PS_EXIT_SYS_ERROR);
    602602    }
    603603
    … …  
    605605
    606606    if (lc($scheme) eq 'file') {
    607         # the above strips of the leading slash; replace it for file://
    608         $name = '/' . $name;
    609         return $name;
     607        # the above strips of the leading slash; replace it for file://
     608        $name = '/' . $name;
     609        return $name;
    610610    }
    611611
    612612    if (lc($scheme) eq 'path') {
    613         my @dirs = split('/', $name);
    614         my $pathName = shift @dirs;
    615         my $path = $self->datapath( $pathName );
    616         $path =~ s|/*$||;
    617         return File::Spec->catfile( $path, @dirs );
     613        my @dirs = split('/', $name);
     614        my $pathName = shift @dirs;
     615        my $path = $self->datapath( $pathName );
     616        $path =~ s|/*$||;
     617        return File::Spec->catfile( $path, @dirs );
    618618    }
    619619
    … …  
    629629sub convert_filename_relative
    630630{
    631     my $self = shift;           # Configuration object
    632     my $name = shift;           # raw name
     631    my $self = shift;                # Configuration object
     632    my $name = shift;                # raw name
    633633   
    634634    unless (defined $self and defined $name) {
    635         carp "Programming error";
    636         exit($PS_EXIT_PROG_ERROR);
     635        carp "Programming error";
     636        exit($PS_EXIT_PROG_ERROR);
    637637    }
    638638   
    … …  
    640640    my $scheme = file_scheme($name); # The scheme, e.g., file, path
    641641    if (defined $scheme) {
    642         $scheme = lc($scheme);
    643         if ($scheme eq 'path' or $scheme eq 'file') {
    644             # We may as well search for a 'better' path
    645             # guaranteed to have a scheme (path:// or file://)
    646             $name = $self->convert_filename_absolute( $name );
    647         } elsif ($scheme eq 'neb') {
    648             # No chance of changing anything --- move along
    649             return $name;
    650         }
     642        $scheme = lc($scheme);
     643        if ($scheme eq 'path' or $scheme eq 'file') {
     644            # We may as well search for a 'better' path
     645            # guaranteed to have a scheme (path:// or file://)
     646            $name = $self->convert_filename_absolute( $name );
     647        } elsif ($scheme eq 'neb') {
     648            # No chance of changing anything --- move along
     649            return $name;
     650        }
    651651    }
    652652   
    … …  
    667667      next if scalar @path_dirs > scalar @dirs;
    668668      for (my $i = 0; $i < scalar @path_dirs; $i++) {
    669           next CFR_PATH_CHECK if $path_dirs[$i] ne $dirs[$i];
     669          next CFR_PATH_CHECK if $path_dirs[$i] ne $dirs[$i];
    670670      }
    671671      # It is suitable; see if it is 'best' (minimizes the number of directories)
    672672      my $score = scalar @path_dirs;
    673673      if (not defined $best_score or $score > $best_score) {
    674           $best_path = $path;
    675           $best_score = $score;
    676           $best_name = $path_name;
     674          $best_path = $path;
     675          $best_score = $score;
     676          $best_name = $path_name;
    677677      }
    678678  }
    … …  
    681681    $name =~ s|/$||;
    682682    if (defined $best_score) {
    683         $best_path =~ s|^/||;
    684         $best_path =~ s|/$||;
    685         $name =~ s|^$best_path|$best_name|;
    686         return 'path://' . $name;
     683        $best_path =~ s|^/||;
     684        $best_path =~ s|/$||;
     685        $name =~ s|^$best_path|$best_name|;
     686        return 'path://' . $name;
    687687    }
    688688    return 'file://' . $name;
    … …  
    692692sub rejection
    693693{
    694     my $self = shift;           # Configuration object
    695     my $name = shift;           # Name of limit
    696     my $type = lc(shift);       # Type of frame
    697     my $filter = shift;         # Filter name, for extra qualification; optional
     694    my $self = shift;                # Configuration object
     695    my $name = shift;                # Name of limit
     696    my $type = lc(shift);        # Type of frame
     697    my $filter = shift;                # Filter name, for extra qualification; optional
    698698
    699699    unless (defined $self and defined $name and defined $type) {
    700         carp "Programming error";
    701         exit($PS_EXIT_PROG_ERROR);
     700        carp "Programming error";
     701        exit($PS_EXIT_PROG_ERROR);
    702702    }
    703703
    704704    unless (defined $self->{rejection}) {
    705         my $camera = $self->{cameraName}; # Camera name
    706         unless (defined $camera) {
    707             carp "Camera has not yet been defined.\n";
    708             return undef;
    709         }
    710        
    711         # rejections are saved as a recipe: REJECTIONS
    712         my @rejContents = `ppConfigDump -dump-recipe REJECTIONS -camera $camera -`;
    713        
    714         # load from resulting psMetadataConfig
    715         $self->{rejection} = $parser->parse( join '', @rejContents); # The rejection metadata
    716         unless (defined $self->{rejection}) {
    717             carp "Unable to parse REJECTION recipe for $camera.";
    718             exit($PS_EXIT_CONFIG_ERROR);
    719         }
     705        my $camera = $self->{cameraName}; # Camera name
     706        unless (defined $camera) {
     707            carp "Camera has not yet been defined.\n";
     708            return undef;
     709        }
     710       
     711        # rejections are saved as a recipe: REJECTIONS
     712        my @rejContents = `ppConfigDump -dump-recipe REJECTIONS -camera $camera -`;
     713       
     714        # load from resulting psMetadataConfig
     715        $self->{rejection} = $parser->parse( join '', @rejContents); # The rejection metadata
     716        unless (defined $self->{rejection}) {
     717            carp "Unable to parse REJECTION recipe for $camera.";
     718            exit($PS_EXIT_CONFIG_ERROR);
     719        }
    720720    }
    721721
    … …  
    725725  TYPES: foreach my $item (@$rejection) {
    726726      if (lc($item->{name}) eq $type) {
    727           unless ($item->{class} eq "metadata") {
    728               carp "$name within REJECTIONS is not of type METADATA";
    729               exit($PS_EXIT_PROG_ERROR);
    730           }
    731           my $limits = $item->{value}; # List of rejection limits
    732 
    733           # Check the FILTER first
    734           foreach my $limit (@$limits) {
    735               if ($limit->{name} eq 'FILTER') {
    736                   if ($limit->{value} eq '*' or
    737                       (defined $filter and
    738                        $limit->{value} eq $filter)) {
    739                       last;
    740                   }
    741                   next TYPES; # Doesn't match --- look at the next one
    742               }
    743           }
    744          
    745           foreach my $limit (@$limits) {
    746               return $limit->{value} if $limit->{name} eq $name;
    747           }
    748           carp "Unable to find limit $name in REJECTIONS list for $type.\n";
    749           return undef;
     727          unless ($item->{class} eq "metadata") {
     728              carp "$name within REJECTIONS is not of type METADATA";
     729              exit($PS_EXIT_PROG_ERROR);
     730          }
     731          my $limits = $item->{value}; # List of rejection limits
     732
     733          # Check the FILTER first
     734          foreach my $limit (@$limits) {
     735              if ($limit->{name} eq 'FILTER') {
     736                  if ($limit->{value} eq '*' or
     737                      (defined $filter and
     738                       $limit->{value} eq $filter)) {
     739                      last;
     740                  }
     741                  next TYPES; # Doesn't match --- look at the next one
     742              }
     743          }
     744         
     745          foreach my $limit (@$limits) {
     746              return $limit->{value} if $limit->{name} eq $name;
     747          }
     748          carp "Unable to find limit $name in REJECTIONS list for $type.\n";
     749          return undef;
    750750      }
    751751  }
    752752
    753753    if (not defined $filter) {
    754         carp "Unable to find type $type with no FILTER in REJECTIONS list.\n";
     754        carp "Unable to find type $type with no FILTER in REJECTIONS list.\n";
    755755    } else {
    756         carp "Unable to find type $type with FILTER $filter in REJECTIONS list.\n";
     756        carp "Unable to find type $type with FILTER $filter in REJECTIONS list.\n";
    757757    }
    758758    return undef;
    … …  
    762762sub filename
    763763{
    764     my $self = shift;           # Configuration object
    765     my $name = shift;           # Name of the file
    766     my $output = shift;         # For replacing {OUTPUT}
    767     my $component = shift;      # For replacing {CHIP.NAME} and {CELL.NAME}
     764    my $self = shift;                # Configuration object
     765    my $name = shift;                # Name of the file
     766    my $output = shift;                # For replacing {OUTPUT}
     767    my $component = shift;        # For replacing {CHIP.NAME} and {CELL.NAME}
    768768
    769769    unless (defined $self and defined $name and defined $output) {
    770         carp "Programming error: required inputs left undefined";
    771         exit($PS_EXIT_PROG_ERROR);
    772     }
    773 
    774     my $filerules;              # File rules
     770        carp "Programming error: required inputs left undefined";
     771        exit($PS_EXIT_PROG_ERROR);
     772    }
     773
     774    my $filerules;                # File rules
    775775    if (defined $self->{filerules}) {
    776         $filerules = $self->{filerules};
     776        $filerules = $self->{filerules};
    777777    } else {
    778         # Get the file rules from the camera configuration
    779 
    780         my $camera = $self->{camera}; # Camera configuration
    781         unless (defined $camera) {
    782             carp "Camera has not yet been defined.\n";
    783             return undef;
    784         }
    785        
    786         $filerules = metadataLookup($camera, 'FILERULES');      # File rules
    787         unless (defined $filerules) {
    788             carp "Can't find FILERULES list in camera configuration.\n";
    789             return undef;
    790         }
    791        
    792         if ($filerules->{class} eq "scalar" and $filerules->{type} eq "STR") {
    793             # Allow indirection to a file
    794             my $filename = $self->_find_config($filerules->{value}); # Resolved filename
    795             # Read the file
    796             my $file;           # File handle
    797             unless (open $file, $filename) {
    798                 carp "Unable to open filerules file $filename: $!";
    799                 exit($PS_EXIT_CONFIG_ERROR);
    800             }
    801             my @contents = <$file>;
    802             close $file;
    803             $filerules = $parser->parse( join '', @contents);
    804         } elsif ($filerules->{class} eq "metadata") {
    805             $filerules = $filerules->{value};
    806         } else {
    807             carp "Can't interpret FILERULES in camera configuration.\n";
    808             return undef;
    809         }
    810         $self->{filerules} = $filerules;
     778        # Get the file rules from the camera configuration
     779
     780        my $camera = $self->{camera}; # Camera configuration
     781        unless (defined $camera) {
     782            carp "Camera has not yet been defined.\n";
     783            return undef;
     784        }
     785       
     786        $filerules = metadataLookup($camera, 'FILERULES');        # File rules
     787        unless (defined $filerules) {
     788            carp "Can't find FILERULES list in camera configuration.\n";
     789            return undef;
     790        }
     791       
     792        if ($filerules->{class} eq "scalar" and $filerules->{type} eq "STR") {
     793            # Allow indirection to a file
     794            my $filename = $self->_find_config($filerules->{value}); # Resolved filename
     795            # Read the file
     796            my $file;                # File handle
     797            unless (open $file, $filename) {
     798                carp "Unable to open filerules file $filename: $!";
     799                exit($PS_EXIT_CONFIG_ERROR);
     800            }
     801            my @contents = <$file>;
     802            close $file;
     803            $filerules = $parser->parse( join '', @contents);
     804        } elsif ($filerules->{class} eq "metadata") {
     805            $filerules = $filerules->{value};
     806        } else {
     807            carp "Can't interpret FILERULES in camera configuration.\n";
     808            return undef;
     809        }
     810        $self->{filerules} = $filerules;
    811811    }
    812812
    813813    my $file = _mdLookupMDwithRedirect($filerules, $name); # The file of interest
    814814    unless (defined $file) {
    815         carp "Can't find $name within FILERULES in camera configuration.\n";
    816         return undef;
     815        carp "Can't find $name within FILERULES in camera configuration.\n";
     816        return undef;
    817817    }
    818818
    819819    my $filename = metadataLookupStr($file, "FILENAME.RULE"); # File name
    820820    unless (defined $filename) {
    821         carp "Can't find FILENAME.RULE for $name within FILERULES in camera configuration.\n";
    822         return undef;
     821        carp "Can't find FILENAME.RULE for $name within FILERULES in camera configuration.\n";
     822        return undef;
    823823    }
    824824
    825825    $filename =~ s/\{OUTPUT\}/$output/;
    826826    if ($filename =~ /\{CHIP\.NAME\}/) {
    827         unless (defined $component) {
    828             carp "Programming error";
    829             exit($PS_EXIT_PROG_ERROR);
    830         }
    831         $filename =~ s/\{CHIP\.NAME\}/$component/;
    832         $filename =~ s/\{CELL\.NAME\}/$component/;
     827        unless (defined $component) {
     828            carp "Programming error";
     829            exit($PS_EXIT_PROG_ERROR);
     830        }
     831        $filename =~ s/\{CHIP\.NAME\}/$component/;
     832        $filename =~ s/\{CELL\.NAME\}/$component/;
    833833    }
    834834
    … …  
    839839sub extname_rule
    840840{
    841     my $self = shift;           # Configuration object
    842     my $name = shift;           # Name of the EXTNAME to build
    843     my $component = shift;      # For replacing {CHIP.NAME}
     841    my $self = shift;                # Configuration object
     842    my $name = shift;                # Name of the EXTNAME to build
     843    my $component = shift;        # For replacing {CHIP.NAME}
    844844
    845845    unless (defined $self and defined $name) {
    846         carp "Programming error";
    847         exit($PS_EXIT_PROG_ERROR);
     846        carp "Programming error";
     847        exit($PS_EXIT_PROG_ERROR);
    848848    }
    849849
    850850    my $camera = $self->{camera}; # Camera configuration
    851851    unless (defined $camera) {
    852         carp "Camera has not yet been defined.\n";
    853         return undef;
    854     }
    855 
    856     my $extname_rules = metadataLookupMD($camera, 'EXTNAME.RULES');     # File rules
     852        carp "Camera has not yet been defined.\n";
     853        return undef;
     854    }
     855
     856    my $extname_rules = metadataLookupMD($camera, 'EXTNAME.RULES');        # File rules
    857857    unless (defined $extname_rules) {
    858         carp "Can't find EXTNAME.RULES in camera configuration.\n";
    859         return undef;
     858        carp "Can't find EXTNAME.RULES in camera configuration.\n";
     859        return undef;
    860860    }
    861861
    862862    my $extname = metadataLookupStr($extname_rules, $name); # File name
    863863    unless (defined $extname) {
    864         carp "Can't find $name within EXTNAME.RULES in camera configuration.\n";
    865         return undef;
     864        carp "Can't find $name within EXTNAME.RULES in camera configuration.\n";
     865        return undef;
    866866    }
    867867
    868868    if ($extname =~ /\{CHIP\.NAME\}/) {
    869         unless (defined $component) {
    870             carp "Programming error";
    871             exit($PS_EXIT_PROG_ERROR);
    872         }
    873         $extname =~ s/\{CHIP\.NAME\}/$component/;
     869        unless (defined $component) {
     870            carp "Programming error";
     871            exit($PS_EXIT_PROG_ERROR);
     872        }
     873        $extname =~ s/\{CHIP\.NAME\}/$component/;
    874874    }
    875875
    … …  
    880880sub tessellation_catdir
    881881{
    882     my $self = shift;           # Configuration object
    883     my $tess_id = shift;        # Tessellation identifier
     882    my $self = shift;                # Configuration object
     883    my $tess_id = shift;        # Tessellation identifier
    884884
    885885    unless (defined $self and defined $self->{_siteConfig} and defined $tess_id) {
    886         carp "Programming error";
    887         exit($PS_EXIT_PROG_ERROR);
     886        carp "Programming error";
     887        exit($PS_EXIT_PROG_ERROR);
    888888    }
    889889
    890890    my $tessellations = metadataLookupMD($self->{_siteConfig}, 'TESSELLATIONS'); # Tessellations
    891891    unless (defined $tessellations) {
    892         carp "Can't find TESSELLATIONS in site configuration.\n";
    893         exit($PS_EXIT_CONFIG_ERROR);
     892        carp "Can't find TESSELLATIONS in site configuration.\n";
     893        exit($PS_EXIT_CONFIG_ERROR);
    894894    }
    895895
    896896    my $catdir = metadataLookupStr($tessellations, $tess_id);
    897897    unless (defined $catdir) {
    898         print "Can't find tessellation identifier $tess_id in TESSELLATIONS in site configuration, assuming it is a filename.\n";
    899         return $tess_id;
     898        print "Can't find tessellation identifier $tess_id in TESSELLATIONS in site configuration, assuming it is a filename.\n";
     899        return $tess_id;
    900900    }
    901901
    … …  
    903903    my $scheme = file_scheme($catdir); # The scheme, e.g., file, path, neb
    904904    if (defined $scheme and lc($scheme) eq 'neb') {
    905         carp "Tessellation $tess_id refers to a Nebulous path: $catdir\n";
    906         exit($PS_EXIT_CONFIG_ERROR);
     905        carp "Tessellation $tess_id refers to a Nebulous path: $catdir\n";
     906        exit($PS_EXIT_CONFIG_ERROR);
    907907    }
    908908
    … …  
    914914sub dvo_catdir
    915915{
    916     my $self = shift;   # Configuration object
    917     my $dvodb = shift;  # DVO db identifier
     916    my $self = shift;        # Configuration object
     917    my $dvodb = shift;        # DVO db identifier
    918918
    919919    unless (defined $self and defined $self->{_siteConfig} and defined $dvodb) {
    920         carp "Programming error";
    921         exit($PS_EXIT_PROG_ERROR);
     920        carp "Programming error";
     921        exit($PS_EXIT_PROG_ERROR);
    922922    }
    923923
    924924    my $catdirs = metadataLookupMD($self->{_siteConfig}, 'DVO.CATDIRS'); # Tessellations
    925925    unless (defined $catdirs) {
    926         carp "Can't find DVO.CATDIRS in site configuration.\n";
    927         exit($PS_EXIT_CONFIG_ERROR);
     926        carp "Can't find DVO.CATDIRS in site configuration.\n";
     927        exit($PS_EXIT_CONFIG_ERROR);
    928928    }
    929929
    930930    my $catdir = metadataLookupStr($catdirs, $dvodb);
    931931    unless (defined $catdir) {
    932         print "Can't find dvodb identifier $dvodb in DVO.CATDIR in site configuration, assuming filename\n";
    933         return $dvodb;
     932        print "Can't find dvodb identifier $dvodb in DVO.CATDIR in site configuration, assuming filename\n";
     933        return $dvodb;
    934934    }
    935935
    … …  
    937937    my $scheme = file_scheme($catdir); # The scheme, e.g., file, path, neb
    938938    if (defined $scheme and lc($scheme) eq 'neb') {
    939         carp "DVO catdir $dvodb refers to a Nebulous path: $catdir\n";
    940         exit($PS_EXIT_CONFIG_ERROR);
     939        carp "DVO catdir $dvodb refers to a Nebulous path: $catdir\n";
     940        exit($PS_EXIT_CONFIG_ERROR);
    941941    }
    942942
    … …  
    947947sub psastro_catdir
    948948{
    949     my $self = shift;   # Configuration object
    950     my $dvodb = shift;  # DVO db identifier
     949    my $self = shift;        # Configuration object
     950    my $dvodb = shift;        # DVO db identifier
    951951
    952952    unless (defined $self and defined $self->{_siteConfig} and defined $dvodb) {
    953         carp "Programming error";
    954         exit($PS_EXIT_PROG_ERROR);
     953        carp "Programming error";
     954        exit($PS_EXIT_PROG_ERROR);
    955955    }
    956956
    957957    my $catdirs = metadataLookupMD($self->{_siteConfig}, 'PSASTRO.CATDIRS'); # Tessellations
    958958    unless (defined $catdirs) {
    959         carp "Can't find PSASTRO.CATDIRS in site configuration.\n";
    960         exit($PS_EXIT_CONFIG_ERROR);
     959        carp "Can't find PSASTRO.CATDIRS in site configuration.\n";
     960        exit($PS_EXIT_CONFIG_ERROR);
    961961    }
    962962
    963963    my $catdir = metadataLookupStr($catdirs, $dvodb);
    964964    unless (defined $catdir) {
    965         print "Can't find dvodb identifier $dvodb in PSASTRO.CATDIR in site configuration, assuming filename.\n";
    966         return $dvodb;
     965        print "Can't find dvodb identifier $dvodb in PSASTRO.CATDIR in site configuration, assuming filename.\n";
     966        return $dvodb;
    967967    }
    968968
    … …  
    970970    my $scheme = file_scheme($catdir); # The scheme, e.g., file, path, neb
    971971    if (defined $scheme and lc($scheme) eq 'neb') {
    972         carp "PSASTRO catdir $dvodb refers to a Nebulous path: $catdir\n";
    973         exit($PS_EXIT_CONFIG_ERROR);
     972        carp "PSASTRO catdir $dvodb refers to a Nebulous path: $catdir\n";
     973        exit($PS_EXIT_CONFIG_ERROR);
    974974    }
    975975
    … …  
    980980sub dvo_cameradir
    981981{
    982     my $self = shift;           # Configuration object
     982    my $self = shift;                # Configuration object
    983983
    984984    unless (defined $self) {
    985         carp "Programming error";
    986         exit($PS_EXIT_PROG_ERROR);
     985        carp "Programming error";
     986        exit($PS_EXIT_PROG_ERROR);
    987987    }
    988988
    989989    my $camera = $self->{camera}; # Camera configuration
    990990    unless (defined $camera) {
    991         carp "Camera has not yet been defined.\n";
    992         return undef;
     991        carp "Camera has not yet been defined.\n";
     992        return undef;
    993993    }
    994994
    995995    my $dir = metadataLookupStr($camera, "DVO.CAMERADIR"); # Directory of interest
    996996    unless (defined $dir) {
    997         carp "Can't find DVO.CAMERADIR in camera configuration.\n";
    998         return undef;
     997        carp "Can't find DVO.CAMERADIR in camera configuration.\n";
     998        return undef;
    999999    }
    10001000
    … …  
    10061006sub reduction
    10071007{
    1008     my $self = shift;           # Configuration object
    1009     my $reduction = shift;      # Reduction class
    1010     my $name = shift;           # Symbolic name of recipe
     1008    my $self = shift;                # Configuration object
     1009    my $reduction = shift;        # Reduction class
     1010    my $name = shift;                # Symbolic name of recipe
    10111011
    10121012    unless (defined $self and defined $reduction and defined $name) {
    1013         carp "Programming error --- inputs undefined";
    1014         exit($PS_EXIT_PROG_ERROR);
     1013        carp "Programming error --- inputs undefined";
     1014        exit($PS_EXIT_PROG_ERROR);
    10151015    }
    10161016
    10171017    my $reductionClasses;
    10181018    if (defined $self->{reductionClasses}) {
    1019         $reductionClasses = $self->{reductionClasses};
     1019        $reductionClasses = $self->{reductionClasses};
    10201020    } else  {
    1021         # load and save the reductionClasses table
    1022 
    1023         # need to have a valid camear
    1024         my $camera = $self->{camera}; # Camera configuration
    1025         unless (defined $camera) {
    1026             carp "Camera has not yet been defined.\n";
    1027             return undef;
    1028         }
    1029 
    1030         $reductionClasses = metadataLookup($camera, 'REDUCTION');       # File rules
    1031 
    1032         unless (defined $reductionClasses) {
    1033             carp "Can't find REDUCTION list in camera configuration.\n";
    1034             return undef;
    1035         }
    1036        
    1037         if ($reductionClasses->{class} eq "scalar" and $reductionClasses->{type} eq "STR") {
    1038             # Allow indirection to a file
    1039             my $filename = $self->_find_config($reductionClasses->{value}); # Resolved filename
    1040             # Read the file
    1041             my $file;           # File handle
    1042             unless (open $file, $filename) {
    1043                 carp "Unable to open reductionClasses file $filename: $!";
    1044                 exit($PS_EXIT_CONFIG_ERROR);
    1045             }
    1046             my @contents = <$file>;
    1047             close $file;
    1048             $reductionClasses = $parser->parse( join '', @contents);
    1049         } elsif ($reductionClasses->{class} eq "metadata") {
    1050             $reductionClasses = $reductionClasses->{value};
    1051         } else {
    1052             carp "Can't interpret REDUCTIONS in camera configuration.\n";
    1053             return undef;
    1054         }
    1055         $self->{reductionClasses} = $reductionClasses;
     1021        # load and save the reductionClasses table
     1022
     1023        # need to have a valid camear
     1024        my $camera = $self->{camera}; # Camera configuration
     1025        unless (defined $camera) {
     1026            carp "Camera has not yet been defined.\n";
     1027            return undef;
     1028        }
     1029
     1030        $reductionClasses = metadataLookup($camera, 'REDUCTION');        # File rules
     1031
     1032        unless (defined $reductionClasses) {
     1033            carp "Can't find REDUCTION list in camera configuration.\n";
     1034            return undef;
     1035        }
     1036       
     1037        if ($reductionClasses->{class} eq "scalar" and $reductionClasses->{type} eq "STR") {
     1038            # Allow indirection to a file
     1039            my $filename = $self->_find_config($reductionClasses->{value}); # Resolved filename
     1040            # Read the file
     1041            my $file;                # File handle
     1042            unless (open $file, $filename) {
     1043                carp "Unable to open reductionClasses file $filename: $!";
     1044                exit($PS_EXIT_CONFIG_ERROR);
     1045            }
     1046            my @contents = <$file>;
     1047            close $file;
     1048            $reductionClasses = $parser->parse( join '', @contents);
     1049        } elsif ($reductionClasses->{class} eq "metadata") {
     1050            $reductionClasses = $reductionClasses->{value};
     1051        } else {
     1052            carp "Can't interpret REDUCTIONS in camera configuration.\n";
     1053            return undef;
     1054        }
     1055        $self->{reductionClasses} = $reductionClasses;
    10561056    }
    10571057
    10581058    my $class = metadataLookupMD($reductionClasses, $reduction) or # Class of interest
    1059         (carp "Can't find $reduction in REDUCTION in camera configuration.\n" and
    1060         exit($PS_EXIT_CONFIG_ERROR));
     1059        (carp "Can't find $reduction in REDUCTION in camera configuration.\n" and
     1060        exit($PS_EXIT_CONFIG_ERROR));
    10611061
    10621062    my $actual = metadataLookupStr($class, $name) or # The actual recipe name of interest
    1063         (carp "Can't find $name in $class in REDUCTION in camera configuration.\n" and
    1064         exit($PS_EXIT_CONFIG_ERROR));
     1063        (carp "Can't find $name in $class in REDUCTION in camera configuration.\n" and
     1064        exit($PS_EXIT_CONFIG_ERROR));
    10651065
    10661066    return $actual;
    … …  
    10691069sub skycell_file
    10701070{
    1071     my $self = shift;           # Configuration object
    1072     my $tess_id = shift;        # Tessellation identifier
    1073     my $skycell_id = shift;     # Skycell identifier
    1074     my $outname = shift;        # Output name
    1075     my $verbose = shift;        # Verbose?
     1071    my $self = shift;                # Configuration object
     1072    my $tess_id = shift;        # Tessellation identifier
     1073    my $skycell_id = shift;        # Skycell identifier
     1074    my $outname = shift;        # Output name
     1075    my $verbose = shift;        # Verbose?
    10761076
    10771077    unless (defined $self and defined $tess_id and defined $skycell_id and defined $outname) {
    1078         carp "Input parameters not defined";
    1079         return 0;
     1078        carp "Input parameters not defined";
     1079        return 0;
    10801080    }
    10811081
    … …  
    10841084    my $tess_dir = $self->tessellation_catdir( $tess_id ); # Tessellation catdir for DVO
    10851085    unless (defined $tess_dir) {
    1086         carp "Can't get list of tessellations.";
    1087         return 0;
     1086        carp "Can't get list of tessellations.";
     1087        return 0;
    10881088    }
    10891089    $tess_dir = $self->convert_filename_absolute( $tess_dir );
    10901090
    10911091    unless ($self->file_exists( $outname )) {
    1092         my $outnameResolved = $self->file_create( $outname ); # Resolved filename, for Nebulous
    1093         my $command = "$dvoImageExtract -D CATDIR $tess_dir $skycell_id -o $outnameResolved";
    1094         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    1095             run(command => $command, verbose => $verbose);
    1096         die "Unable to perform dvoImageExtract for $tess_id $skycell_id\n" unless ($success and $self->file_exists( $outname ));
     1092        my $outnameResolved = $self->file_create( $outname ); # Resolved filename, for Nebulous
     1093        my $command = "$dvoImageExtract -D CATDIR $tess_dir $skycell_id -o $outnameResolved";
     1094        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     1095            run(command => $command, verbose => $verbose);
     1096        die "Unable to perform dvoImageExtract for $tess_id $skycell_id\n" unless ($success and $self->file_exists( $outname ));
    10971097    }
    10981098
    … …  
    11031103sub _interpolate_env
    11041104{
    1105     my $dir = shift;            # Directory of interest
     1105    my $dir = shift;                # Directory of interest
    11061106
    11071107    return undef unless defined $dir;
    11081108
    11091109    while ($dir =~ /\$\{?(\w*)[\}\/:]?/) {
    1110         my $name = $1;          # Environment variable name
    1111         my $value = $ENV{$name}; # Environment variable value
    1112         unless (defined $value) {
    1113             carp "Unable to find environment variable $name";
    1114             exit($PS_EXIT_SYS_ERROR);
    1115         }
    1116         $dir =~ s/\$\{?$name\}?/$value\//;
     1110        my $name = $1;                # Environment variable name
     1111        my $value = $ENV{$name}; # Environment variable value
     1112        unless (defined $value) {
     1113            carp "Unable to find environment variable $name";
     1114            exit($PS_EXIT_SYS_ERROR);
     1115        }
     1116        $dir =~ s/\$\{?$name\}?/$value\//;
    11171117    }
    11181118    return $dir;
    … …  
    11211121sub metadataLookup
    11221122{
    1123     my $mdc = shift;            # Metadata config to look up
    1124     my $name = shift;           # Name of item to look up
     1123    my $mdc = shift;                # Metadata config to look up
     1124    my $name = shift;                # Name of item to look up
    11251125
    11261126    unless (defined $mdc and defined $name) {
    1127         carp "Programming error";
    1128         exit($PS_EXIT_PROG_ERROR);
     1127        carp "Programming error";
     1128        exit($PS_EXIT_PROG_ERROR);
    11291129    }
    11301130
    11311131    # Iterate through the array of hashes
    11321132    foreach my $item (@$mdc) {
    1133         if ($item->{name} eq $name) {
    1134             return $item;
    1135         }
     1133        if ($item->{name} eq $name) {
     1134            return $item;
     1135        }
    11361136    }
    11371137
    … …  
    11461146    my $item = metadataLookup(@_);
    11471147    return undef if not defined $item;
    1148     my $name = shift;           # Name of item
     1148    my $name = shift;                # Name of item
    11491149    carp "$name within metadata is not of type STR.\n" unless $item->{type} eq "STR";
    11501150    return $item->{value};
    … …  
    11561156    my $item = metadataLookup(@_);
    11571157    return undef if not defined $item;
    1158     my $name = shift;           # Name of item
     1158    my $name = shift;                # Name of item
    11591159    carp "$name within metadata is not of type METADATA.\n" unless $item->{class} eq "metadata";
    11601160    return $item->{value};
    … …  
    11661166    my $item = metadataLookup(@_);
    11671167    return undef if not defined $item;
    1168     my $name = shift;           # Name of item
     1168    my $name = shift;                # Name of item
    11691169    carp "$name within metadata is not of type BOOL.\n" unless $item->{type} eq "BOOL";
    11701170    return $item->{value};
    … …  
    11741174sub _mdLookupMDwithRedirect
    11751175{
    1176     my $mdc = shift;            # Metadata config to look up
    1177     my $name = shift;           # Name of item to look ip
     1176    my $mdc = shift;                # Metadata config to look up
     1177    my $name = shift;                # Name of item to look ip
    11781178
    11791179    unless (defined $mdc and defined $name) {
    1180         carp "Programming error";
    1181         exit($PS_EXIT_PROG_ERROR);
     1180        carp "Programming error";
     1181        exit($PS_EXIT_PROG_ERROR);
    11821182    }
    11831183
    11841184    # Iterate through the array of hashes
    11851185    foreach my $item (@$mdc) {
    1186         if ($item->{name} eq $name) {
    1187             if ($item->{class} eq "metadata") {
    1188                 return $item->{value};
    1189             }
    1190             if ($item->{class} eq "scalar" and $item->{type} eq "STR") {
    1191                 # Redirect
    1192                 return _mdLookupMDwithRedirect($mdc, $item->{value});
    1193             }
    1194             carp "$name within metadata is not of type METADATA or STR.\n";
    1195             return undef;
    1196         }
     1186        if ($item->{name} eq $name) {
     1187            if ($item->{class} eq "metadata") {
     1188                return $item->{value};
     1189            }
     1190            if ($item->{class} eq "scalar" and $item->{type} eq "STR") {
     1191                # Redirect
     1192                return _mdLookupMDwithRedirect($mdc, $item->{value});
     1193            }
     1194            carp "$name within metadata is not of type METADATA or STR.\n";
     1195            return undef;
     1196        }
    11971197    }
    11981198
Note: See TracChangeset for help on using the changeset viewer.