Index: /trunk/PS-IPP-Config/lib/PS/IPP/Config.pm =================================================================== --- /trunk/PS-IPP-Config/lib/PS/IPP/Config.pm (revision 17666) +++ /trunk/PS-IPP-Config/lib/PS/IPP/Config.pm (revision 17667) @@ -1,5 +1,5 @@ # Copyright (c) 2006 Paul Price, Joshua Hoblitt # -# $Id: Config.pm,v 1.84 2008-05-14 01:52:31 bills Exp $ +# $Id: Config.pm,v 1.85 2008-05-14 02:06:02 jhoblitt Exp $ package PS::IPP::Config; @@ -21,17 +21,17 @@ our @EXPORT_OK = qw( - $PS_EXIT_SUCCESS - $PS_EXIT_UNKNOWN_ERROR - $PS_EXIT_SYS_ERROR - $PS_EXIT_CONFIG_ERROR - $PS_EXIT_PROG_ERROR - $PS_EXIT_DATA_ERROR - $PS_EXIT_TIMEOUT_ERROR - metadataLookupStr - metadataLookupMD - metadataLookupBool - caturi - file_scheme - ); + $PS_EXIT_SUCCESS + $PS_EXIT_UNKNOWN_ERROR + $PS_EXIT_SYS_ERROR + $PS_EXIT_CONFIG_ERROR + $PS_EXIT_PROG_ERROR + $PS_EXIT_DATA_ERROR + $PS_EXIT_TIMEOUT_ERROR + metadataLookupStr + metadataLookupMD + metadataLookupBool + caturi + file_scheme + ); our %EXPORT_TAGS = (standard => [@EXPORT_OK]); @@ -45,5 +45,5 @@ our $parser = PS::IPP::Metadata::Config->new; # Metadata parser -$parser->overwrite(0); # Turn off overwrite +$parser->overwrite(0); # Turn off overwrite #$::RD_TRACE = 1; @@ -53,26 +53,26 @@ # Given a parsed metadata, parse it into an array of hashes sub new { - my $class = shift; # Class name - my $camera = shift; # Camera name + my $class = shift; # Class name + my $camera = shift; # Camera name unless (defined $class) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } # Get location of ipprc file - my $name; # Name of ipprc file + my $name; # Name of ipprc file GetOptions( 'site=s' => \$name ); $name = $ENV{IPPRC} if not defined $name; if (not defined $name and defined $ENV{HOME}) { - $name = $ENV{HOME} . '/.ipprc'; - } - - my $file; # File handle + $name = $ENV{HOME} . '/.ipprc'; + } + + my $file; # File handle unless (open $file, $name) { - carp "Unable to open ipprc file $name: $!"; - exit($PS_EXIT_CONFIG_ERROR); - } - my @contents = <$file>; # Contents of the ipprc file + carp "Unable to open ipprc file $name: $!"; + exit($PS_EXIT_CONFIG_ERROR); + } + my @contents = <$file>; # Contents of the ipprc file close $file; @@ -81,6 +81,6 @@ my $path = _interpolate_env(metadataLookupStr($mdc, 'PATH')); # The path unless (defined $path) { - carp "PATH is not set in $name\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "PATH is not set in $name\n"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -88,13 +88,13 @@ my $self = { - path => $path, # Path - camera => undef, # Camera configuration - filerules => undef, # File rules from the camera configuration - rejection => undef, # Rejection data - reductionClasses => undef, # Reduction class definitions - _userConfig => $mdc, # The top-level user configuration - _siteConfig => undef, # The site configuration (from _userConfig) - _systemConfig => undef # The system configuration (from _userConfig) - }; + path => $path, # Path + camera => undef, # Camera configuration + filerules => undef, # File rules from the camera configuration + rejection => undef, # Rejection data + reductionClasses => undef, # Reduction class definitions + _userConfig => $mdc, # The top-level user configuration + _siteConfig => undef, # The site configuration (from _userConfig) + _systemConfig => undef # The system configuration (from _userConfig) + }; bless $self, $class; @@ -110,36 +110,36 @@ sub _find_config { - my $self = shift; # Configuration object - my $filename = shift; # File name to find + my $self = shift; # Configuration object + my $filename = shift; # File name to find my @path = split /:/, $self->{path}; # List of paths to try - my $found = 0; # Found it? + my $found = 0; # Found it? my $realfile; my $tries = 0; while (not $found) { - ## try a second time - foreach my $path (@path) { - $realfile = File::Spec->rel2abs( $filename, $path ); - if ($tries) { - print "re-trying ($tries): filename: $filename, path: $path -> "; - print "test: $realfile\n"; - } - if (-f $realfile) { - $found = 1; - return $realfile; - } - } - if (not $found) { - $tries ++; - if ($tries > 4) { - unless ($found) { - carp "Unable to find camera configuration file $filename\n"; - exit($PS_EXIT_CONFIG_ERROR); - } - } - ## try again after a moment? - ## system ("df"); - select(undef, undef, undef, 0.25); - } + ## try a second time + foreach my $path (@path) { + $realfile = File::Spec->rel2abs( $filename, $path ); + if ($tries) { + print "re-trying ($tries): filename: $filename, path: $path -> "; + print "test: $realfile\n"; + } + if (-f $realfile) { + $found = 1; + return $realfile; + } + } + if (not $found) { + $tries ++; + if ($tries > 4) { + unless ($found) { + carp "Unable to find camera configuration file $filename\n"; + exit($PS_EXIT_CONFIG_ERROR); + } + } + ## try again after a moment? + ## system ("df"); + select(undef, undef, undef, 0.25); + } } @@ -151,17 +151,17 @@ sub load_site { - my $self = shift; # Configuration object + my $self = shift; # Configuration object my $i = 0; unless (defined $self) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } my $filename = metadataLookupStr($self->{_userConfig}, 'SITE'); # Site config file unless (defined $filename) { - carp "Unable to find site configuration file\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to find site configuration file\n"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -169,8 +169,8 @@ # Read the file - my $file; # File handle + my $file; # File handle unless (open $file, $realfile) { - carp "Unable to open site configuration file $realfile: $!"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to open site configuration file $realfile: $!"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -180,6 +180,6 @@ unless (defined $self->{_siteConfig}) { - carp "Failure to parse the site configuration file $realfile"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Failure to parse the site configuration file $realfile"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -190,15 +190,15 @@ sub load_system { - my $self = shift; # Configuration object + my $self = shift; # Configuration object unless (defined $self) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } my $filename = metadataLookupStr($self->{_userConfig}, 'SYSTEM'); # System config file unless (defined $filename) { - carp "Unable to find system configuration file\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to find system configuration file\n"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -206,8 +206,8 @@ # Read the file - my $file; # File handle + my $file; # File handle unless (open $file, $realfile) { - carp "Unable to open system configuration file $realfile: $!"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to open system configuration file $realfile: $!"; + exit($PS_EXIT_CONFIG_ERROR); } my @contents = <$file>; @@ -216,6 +216,6 @@ unless (defined $self->{_systemConfig}) { - carp "Failure to define system configuration"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Failure to define system configuration"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -227,10 +227,10 @@ sub define_camera { - my $self = shift; # Configuration object - my $name = shift; # Camera name + my $self = shift; # Configuration object + my $name = shift; # Camera name unless (defined $self and defined $name) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } @@ -238,6 +238,6 @@ my $filename = metadataLookupStr($camera_list, $name); # Filename of camera configuration unless (defined $filename) { - carp "Unable to find configuration file for camera $name\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to find configuration file for camera $name\n"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -245,8 +245,8 @@ # Read the file - my $file; # File handle + my $file; # File handle unless (open $file, $realfile) { - carp "Unable to open camera configuration file $realfile: $!"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to open camera configuration file $realfile: $!"; + exit($PS_EXIT_CONFIG_ERROR); } my @contents = <$file>; @@ -256,6 +256,6 @@ unless (defined $self->{camera}) { - carp "Failure to define camera"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Failure to define camera"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -267,5 +267,5 @@ sub file_scheme { - my $name = shift; # Filename for which to get the scheme + my $name = shift; # Filename for which to get the scheme my ($scheme) = $name =~ /^(path|neb|file):/; # The scheme, e.g., file://, path:// # $scheme may be undef if the input doesn't contain one of the above recognised schemes @@ -277,6 +277,6 @@ sub caturi { - my $base = shift; # Base name (might be "foo /foo path://SOMETHING" or "neb://SOMETHING") - my @segments = @_; # Path segments + my $base = shift; # Base name (might be "foo /foo path://SOMETHING" or "neb://SOMETHING") + my @segments = @_; # Path segments carp "base is not inited" if not defined $base; @@ -291,6 +291,6 @@ # Remove leading and trailing slashes foreach my $segment ( @segments ) { - $segment =~ s|^/*||; - $segment =~ s|/*$||; + $segment =~ s|^/*||; + $segment =~ s|/*$||; } @@ -298,7 +298,7 @@ my $joined = join('/', @segments); if (defined $scheme) { - $joined = lc($scheme) . "://" . $joined; + $joined = lc($scheme) . "://" . $joined; } else { - $joined = $root . $joined; + $joined = $root . $joined; } @@ -309,10 +309,10 @@ sub datapath { - my $self = shift; # Configuration object - my $name = shift; # datapath name + my $self = shift; # Configuration object + my $name = shift; # datapath name unless (defined $self and defined $name) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } @@ -320,6 +320,6 @@ my $pathname = metadataLookupStr($path_list, $name); # Path of interest unless (defined $pathname) { - carp "Unable to find datapath $name\n" ; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to find datapath $name\n" ; + exit($PS_EXIT_CONFIG_ERROR); } @@ -330,12 +330,12 @@ sub _neb_start { - my $self = shift; # Configuration object + my $self = shift; # Configuration object eval { - require Nebulous::Client; + require Nebulous::Client; }; if ($@) { - carp "Can't find Nebulous::Client."; - exit($PS_EXIT_PROG_ERROR); + carp "Can't find Nebulous::Client."; + exit($PS_EXIT_PROG_ERROR); } @@ -344,12 +344,12 @@ my $server = metadataLookupStr( $self->{_siteConfig}, 'NEB_SERVER' ); # Nebulous server unless (defined $server) { - carp "Unable to find NEB_SERVER in camera configuration file."; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to find NEB_SERVER in camera configuration file."; + exit($PS_EXIT_CONFIG_ERROR); } my $neb = Nebulous::Client->new( proxy => $server ); unless (defined $neb) { - carp "Unable to find NEB_SERVER in camera configuration file."; - exit($PS_EXIT_CONFIG_ERROR); + carp "Unable to find NEB_SERVER in camera configuration file."; + exit($PS_EXIT_CONFIG_ERROR); } @@ -362,7 +362,7 @@ sub file_resolve { - my $self = shift; # Configuration object - my $name = shift; # File name to check - my $touch = shift; # if $name is in nebulous instantiate it + my $self = shift; # Configuration object + my $name = shift; # File name to check + my $touch = shift; # if $name is in nebulous instantiate it my $scheme = file_scheme($name); # The scheme, e.g., file://, path:// @@ -372,7 +372,7 @@ if ($scheme eq 'neb') { - $name =~ s|^neb:/*||; - $self->_neb_start(); - my $neb = $self->{nebulous}; # Nebulous handle + $name =~ s|^neb:/*||; + $self->_neb_start(); + my $neb = $self->{nebulous}; # Nebulous handle if ($touch) { unless ($neb->stat( $name )) { @@ -383,9 +383,9 @@ } } - return $neb->find( $name ); + return $neb->find( $name ); } if ($scheme eq 'path' or $scheme eq 'file') { - # guaranteed to have a scheme (path:// or file://) - return $self->convert_filename_absolute( $name ); + # guaranteed to have a scheme (path:// or file://) + return $self->convert_filename_absolute( $name ); } @@ -396,6 +396,6 @@ sub file_create_open { - my $self = shift; # Configuration object - my $name = shift; # File name to check + my $self = shift; # Configuration object + my $name = shift; # File name to check $self->file_prepare( $name ); @@ -403,25 +403,25 @@ my $scheme = file_scheme($name); # The scheme, e.g., file://, path:// if (defined $scheme) { - $scheme = lc($scheme); - if ($scheme eq 'neb') { - $name =~ s|^neb:/*||; - $self->_neb_start(); - return $self->{nebulous}->open_create( $name ); - } - if ($scheme eq 'path' or $scheme eq 'file') { - # guaranteed to have a scheme (path:// or file://) - $name = $self->convert_filename_absolute( $name ); - } + $scheme = lc($scheme); + if ($scheme eq 'neb') { + $name =~ s|^neb:/*||; + $self->_neb_start(); + return $self->{nebulous}->open_create( $name ); + } + if ($scheme eq 'path' or $scheme eq 'file') { + # guaranteed to have a scheme (path:// or file://) + $name = $self->convert_filename_absolute( $name ); + } } if (-f $name) { - carp "Unable to create file $name --- file exists."; - exit($PS_EXIT_SYS_ERROR); + carp "Unable to create file $name --- file exists."; + exit($PS_EXIT_SYS_ERROR); } my $fh; unless (open $fh, '>', $name) { - carp "Unable to create file $name --- $!"; - exit($PS_EXIT_SYS_ERROR); + carp "Unable to create file $name --- $!"; + exit($PS_EXIT_SYS_ERROR); } return $fh; @@ -431,6 +431,6 @@ sub file_create_append { - my $self = shift; # Configuration object - my $name = shift; # File name to check + my $self = shift; # Configuration object + my $name = shift; # File name to check $self->file_prepare( $name ); @@ -438,20 +438,20 @@ my $scheme = file_scheme($name); # The scheme, e.g., file://, path:// if (defined $scheme) { - $scheme = lc($scheme); - if ($scheme eq 'neb') { - $name =~ s|^neb:/*||; - $self->_neb_start(); - return $self->{nebulous}->open_create( $name ); - } - if ($scheme eq 'path' or $scheme eq 'file') { - # guaranteed to have a scheme (path:// or file://) - $name = $self->convert_filename_absolute( $name ); - } + $scheme = lc($scheme); + if ($scheme eq 'neb') { + $name =~ s|^neb:/*||; + $self->_neb_start(); + return $self->{nebulous}->open_create( $name ); + } + if ($scheme eq 'path' or $scheme eq 'file') { + # guaranteed to have a scheme (path:// or file://) + $name = $self->convert_filename_absolute( $name ); + } } my $fh; unless (open $fh, '>>', $name) { - carp "Unable to create file $name --- $!"; - exit($PS_EXIT_SYS_ERROR); + carp "Unable to create file $name --- $!"; + exit($PS_EXIT_SYS_ERROR); } return $fh; @@ -461,6 +461,6 @@ sub file_create { - my $self = shift; # Configuration object - my $name = shift; # File name to check + my $self = shift; # Configuration object + my $name = shift; # File name to check $self->file_prepare( $name ); @@ -468,7 +468,7 @@ my $scheme = file_scheme($name); # The scheme, e.g., file://, path:// if (defined $scheme and lc($scheme) eq 'neb') { - $name =~ s|^neb:/*||; - $self->_neb_start(); - $name = $self->{nebulous}->create( $name ); + $name =~ s|^neb:/*||; + $self->_neb_start(); + $name = $self->{nebulous}->create( $name ); } @@ -479,12 +479,12 @@ sub file_exists { - my $self = shift; # Configuration object - my $name = shift; # File name to check + my $self = shift; # Configuration object + my $name = shift; # File name to check my $scheme = file_scheme($name); # The scheme, e.g., file://, path:// if (defined $scheme and lc($scheme) eq 'neb') { - $name =~ s|^neb:/*||; - $self->_neb_start(); - return (defined $self->{nebulous}->find_instances( $name ) ? 1 : 0); + $name =~ s|^neb:/*||; + $self->_neb_start(); + return (defined $self->{nebulous}->find_instances( $name ) ? 1 : 0); } @@ -495,7 +495,7 @@ sub file_copy { - my $self = shift; # Configuration object - my $source = shift; # Name of source file - my $target = shift; # Name of target file + my $self = shift; # Configuration object + my $source = shift; # Name of source file + my $target = shift; # Name of target file $self->file_prepare( $target ); @@ -503,7 +503,7 @@ my $scheme = file_scheme($target); # The scheme, e.g., file://, path:// if (defined $scheme and lc($scheme) eq 'neb') { - $target =~ s|^neb:/*||; - $self->_neb_start(); - $target = $self->{nebulous}->create( $target ); + $target =~ s|^neb:/*||; + $self->_neb_start(); + $target = $self->{nebulous}->create( $target ); } $target = $self->file_resolve( $target ); @@ -511,5 +511,5 @@ system("cp $source $target") == 0 or (carp "Can't copy file $source to $target." and - exit($PS_EXIT_DATA_ERROR)); + exit($PS_EXIT_DATA_ERROR)); return 1; } @@ -518,5 +518,5 @@ sub _strip_filename { - my $name = shift; # File name of interest + my $name = shift; # File name of interest $name =~ s|/[\w.-]*?$||; return $name; @@ -527,15 +527,15 @@ sub file_prepare { - my $self = shift; # Configuration object - my $name = shift; # File name for which to prepare - my $workdir = shift; # Working directory - my $template = shift; # Template filename from which to get working directory if + my $self = shift; # Configuration object + my $name = shift; # File name for which to prepare + my $workdir = shift; # Working directory + my $template = shift; # Template filename from which to get working directory if if (defined $workdir) { - $name = caturi( $workdir, $name ); + $name = caturi( $workdir, $name ); } elsif (defined $template) { - # Take directory from template and apply to name - my $dir = _strip_filename( $template ); - $name = caturi( $dir, $name ); + # Take directory from template and apply to name + my $dir = _strip_filename( $template ); + $name = caturi( $dir, $name ); } @@ -549,5 +549,5 @@ my ( $vol, $dirs, $file ) = File::Spec->splitpath( $resolved ); unless (-d $dirs) { - system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR)); + system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR)); } @@ -559,6 +559,6 @@ sub outroot_prepare { - my $self = shift; # Configuration object - my $outroot = shift; # Working directory + my $self = shift; # Configuration object + my $outroot = shift; # Working directory # outroot is a directory + fragement of a filename @@ -573,5 +573,5 @@ my ( $vol, $dirs, $file ) = File::Spec->splitpath( $resolved ); unless (-d $dirs) { - system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR)); + system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR)); } @@ -583,10 +583,10 @@ sub convert_filename_absolute { - my $self = shift; # Configuration object - my $name = shift; # raw name + my $self = shift; # Configuration object + my $name = shift; # raw name unless (defined $self and defined $name) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } @@ -596,8 +596,8 @@ ## if this is already an absolute path (/PATH/file), just return the path unless (defined $scheme) { - if ($name =~ m|^/|) { return $name; } - # without a leading slash, this is an error - carp "Relative file name provided: relative paths are not permitted."; - exit($PS_EXIT_SYS_ERROR); + if ($name =~ m|^/|) { return $name; } + # without a leading slash, this is an error + carp "Relative file name provided: relative paths are not permitted."; + exit($PS_EXIT_SYS_ERROR); } @@ -605,15 +605,15 @@ if (lc($scheme) eq 'file') { - # the above strips of the leading slash; replace it for file:// - $name = '/' . $name; - return $name; + # the above strips of the leading slash; replace it for file:// + $name = '/' . $name; + return $name; } if (lc($scheme) eq 'path') { - my @dirs = split('/', $name); - my $pathName = shift @dirs; - my $path = $self->datapath( $pathName ); - $path =~ s|/*$||; - return File::Spec->catfile( $path, @dirs ); + my @dirs = split('/', $name); + my $pathName = shift @dirs; + my $path = $self->datapath( $pathName ); + $path =~ s|/*$||; + return File::Spec->catfile( $path, @dirs ); } @@ -629,10 +629,10 @@ sub convert_filename_relative { - my $self = shift; # Configuration object - my $name = shift; # raw name + my $self = shift; # Configuration object + my $name = shift; # raw name unless (defined $self and defined $name) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } @@ -640,13 +640,13 @@ my $scheme = file_scheme($name); # The scheme, e.g., file, path if (defined $scheme) { - $scheme = lc($scheme); - if ($scheme eq 'path' or $scheme eq 'file') { - # We may as well search for a 'better' path - # guaranteed to have a scheme (path:// or file://) - $name = $self->convert_filename_absolute( $name ); - } elsif ($scheme eq 'neb') { - # No chance of changing anything --- move along - return $name; - } + $scheme = lc($scheme); + if ($scheme eq 'path' or $scheme eq 'file') { + # We may as well search for a 'better' path + # guaranteed to have a scheme (path:// or file://) + $name = $self->convert_filename_absolute( $name ); + } elsif ($scheme eq 'neb') { + # No chance of changing anything --- move along + return $name; + } } @@ -667,12 +667,12 @@ next if scalar @path_dirs > scalar @dirs; for (my $i = 0; $i < scalar @path_dirs; $i++) { - next CFR_PATH_CHECK if $path_dirs[$i] ne $dirs[$i]; + next CFR_PATH_CHECK if $path_dirs[$i] ne $dirs[$i]; } # It is suitable; see if it is 'best' (minimizes the number of directories) my $score = scalar @path_dirs; if (not defined $best_score or $score > $best_score) { - $best_path = $path; - $best_score = $score; - $best_name = $path_name; + $best_path = $path; + $best_score = $score; + $best_name = $path_name; } } @@ -681,8 +681,8 @@ $name =~ s|/$||; if (defined $best_score) { - $best_path =~ s|^/||; - $best_path =~ s|/$||; - $name =~ s|^$best_path|$best_name|; - return 'path://' . $name; + $best_path =~ s|^/||; + $best_path =~ s|/$||; + $name =~ s|^$best_path|$best_name|; + return 'path://' . $name; } return 'file://' . $name; @@ -692,30 +692,30 @@ sub rejection { - my $self = shift; # Configuration object - my $name = shift; # Name of limit - my $type = lc(shift); # Type of frame - my $filter = shift; # Filter name, for extra qualification; optional + my $self = shift; # Configuration object + my $name = shift; # Name of limit + my $type = lc(shift); # Type of frame + my $filter = shift; # Filter name, for extra qualification; optional unless (defined $self and defined $name and defined $type) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } unless (defined $self->{rejection}) { - my $camera = $self->{cameraName}; # Camera name - unless (defined $camera) { - carp "Camera has not yet been defined.\n"; - return undef; - } - - # rejections are saved as a recipe: REJECTIONS - my @rejContents = `ppConfigDump -dump-recipe REJECTIONS -camera $camera -`; - - # load from resulting psMetadataConfig - $self->{rejection} = $parser->parse( join '', @rejContents); # The rejection metadata - unless (defined $self->{rejection}) { - carp "Unable to parse REJECTION recipe for $camera."; - exit($PS_EXIT_CONFIG_ERROR); - } + my $camera = $self->{cameraName}; # Camera name + unless (defined $camera) { + carp "Camera has not yet been defined.\n"; + return undef; + } + + # rejections are saved as a recipe: REJECTIONS + my @rejContents = `ppConfigDump -dump-recipe REJECTIONS -camera $camera -`; + + # load from resulting psMetadataConfig + $self->{rejection} = $parser->parse( join '', @rejContents); # The rejection metadata + unless (defined $self->{rejection}) { + carp "Unable to parse REJECTION recipe for $camera."; + exit($PS_EXIT_CONFIG_ERROR); + } } @@ -725,34 +725,34 @@ TYPES: foreach my $item (@$rejection) { if (lc($item->{name}) eq $type) { - unless ($item->{class} eq "metadata") { - carp "$name within REJECTIONS is not of type METADATA"; - exit($PS_EXIT_PROG_ERROR); - } - my $limits = $item->{value}; # List of rejection limits - - # Check the FILTER first - foreach my $limit (@$limits) { - if ($limit->{name} eq 'FILTER') { - if ($limit->{value} eq '*' or - (defined $filter and - $limit->{value} eq $filter)) { - last; - } - next TYPES; # Doesn't match --- look at the next one - } - } - - foreach my $limit (@$limits) { - return $limit->{value} if $limit->{name} eq $name; - } - carp "Unable to find limit $name in REJECTIONS list for $type.\n"; - return undef; + unless ($item->{class} eq "metadata") { + carp "$name within REJECTIONS is not of type METADATA"; + exit($PS_EXIT_PROG_ERROR); + } + my $limits = $item->{value}; # List of rejection limits + + # Check the FILTER first + foreach my $limit (@$limits) { + if ($limit->{name} eq 'FILTER') { + if ($limit->{value} eq '*' or + (defined $filter and + $limit->{value} eq $filter)) { + last; + } + next TYPES; # Doesn't match --- look at the next one + } + } + + foreach my $limit (@$limits) { + return $limit->{value} if $limit->{name} eq $name; + } + carp "Unable to find limit $name in REJECTIONS list for $type.\n"; + return undef; } } if (not defined $filter) { - carp "Unable to find type $type with no FILTER in REJECTIONS list.\n"; + carp "Unable to find type $type with no FILTER in REJECTIONS list.\n"; } else { - carp "Unable to find type $type with FILTER $filter in REJECTIONS list.\n"; + carp "Unable to find type $type with FILTER $filter in REJECTIONS list.\n"; } return undef; @@ -762,73 +762,73 @@ sub filename { - my $self = shift; # Configuration object - my $name = shift; # Name of the file - my $output = shift; # For replacing {OUTPUT} - my $component = shift; # For replacing {CHIP.NAME} and {CELL.NAME} + my $self = shift; # Configuration object + my $name = shift; # Name of the file + my $output = shift; # For replacing {OUTPUT} + my $component = shift; # For replacing {CHIP.NAME} and {CELL.NAME} unless (defined $self and defined $name and defined $output) { - carp "Programming error: required inputs left undefined"; - exit($PS_EXIT_PROG_ERROR); - } - - my $filerules; # File rules + carp "Programming error: required inputs left undefined"; + exit($PS_EXIT_PROG_ERROR); + } + + my $filerules; # File rules if (defined $self->{filerules}) { - $filerules = $self->{filerules}; + $filerules = $self->{filerules}; } else { - # Get the file rules from the camera configuration - - my $camera = $self->{camera}; # Camera configuration - unless (defined $camera) { - carp "Camera has not yet been defined.\n"; - return undef; - } - - $filerules = metadataLookup($camera, 'FILERULES'); # File rules - unless (defined $filerules) { - carp "Can't find FILERULES list in camera configuration.\n"; - return undef; - } - - if ($filerules->{class} eq "scalar" and $filerules->{type} eq "STR") { - # Allow indirection to a file - my $filename = $self->_find_config($filerules->{value}); # Resolved filename - # Read the file - my $file; # File handle - unless (open $file, $filename) { - carp "Unable to open filerules file $filename: $!"; - exit($PS_EXIT_CONFIG_ERROR); - } - my @contents = <$file>; - close $file; - $filerules = $parser->parse( join '', @contents); - } elsif ($filerules->{class} eq "metadata") { - $filerules = $filerules->{value}; - } else { - carp "Can't interpret FILERULES in camera configuration.\n"; - return undef; - } - $self->{filerules} = $filerules; + # Get the file rules from the camera configuration + + my $camera = $self->{camera}; # Camera configuration + unless (defined $camera) { + carp "Camera has not yet been defined.\n"; + return undef; + } + + $filerules = metadataLookup($camera, 'FILERULES'); # File rules + unless (defined $filerules) { + carp "Can't find FILERULES list in camera configuration.\n"; + return undef; + } + + if ($filerules->{class} eq "scalar" and $filerules->{type} eq "STR") { + # Allow indirection to a file + my $filename = $self->_find_config($filerules->{value}); # Resolved filename + # Read the file + my $file; # File handle + unless (open $file, $filename) { + carp "Unable to open filerules file $filename: $!"; + exit($PS_EXIT_CONFIG_ERROR); + } + my @contents = <$file>; + close $file; + $filerules = $parser->parse( join '', @contents); + } elsif ($filerules->{class} eq "metadata") { + $filerules = $filerules->{value}; + } else { + carp "Can't interpret FILERULES in camera configuration.\n"; + return undef; + } + $self->{filerules} = $filerules; } my $file = _mdLookupMDwithRedirect($filerules, $name); # The file of interest unless (defined $file) { - carp "Can't find $name within FILERULES in camera configuration.\n"; - return undef; + carp "Can't find $name within FILERULES in camera configuration.\n"; + return undef; } my $filename = metadataLookupStr($file, "FILENAME.RULE"); # File name unless (defined $filename) { - carp "Can't find FILENAME.RULE for $name within FILERULES in camera configuration.\n"; - return undef; + carp "Can't find FILENAME.RULE for $name within FILERULES in camera configuration.\n"; + return undef; } $filename =~ s/\{OUTPUT\}/$output/; if ($filename =~ /\{CHIP\.NAME\}/) { - unless (defined $component) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); - } - $filename =~ s/\{CHIP\.NAME\}/$component/; - $filename =~ s/\{CELL\.NAME\}/$component/; + unless (defined $component) { + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); + } + $filename =~ s/\{CHIP\.NAME\}/$component/; + $filename =~ s/\{CELL\.NAME\}/$component/; } @@ -839,37 +839,37 @@ sub extname_rule { - my $self = shift; # Configuration object - my $name = shift; # Name of the EXTNAME to build - my $component = shift; # For replacing {CHIP.NAME} + my $self = shift; # Configuration object + my $name = shift; # Name of the EXTNAME to build + my $component = shift; # For replacing {CHIP.NAME} unless (defined $self and defined $name) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } my $camera = $self->{camera}; # Camera configuration unless (defined $camera) { - carp "Camera has not yet been defined.\n"; - return undef; - } - - my $extname_rules = metadataLookupMD($camera, 'EXTNAME.RULES'); # File rules + carp "Camera has not yet been defined.\n"; + return undef; + } + + my $extname_rules = metadataLookupMD($camera, 'EXTNAME.RULES'); # File rules unless (defined $extname_rules) { - carp "Can't find EXTNAME.RULES in camera configuration.\n"; - return undef; + carp "Can't find EXTNAME.RULES in camera configuration.\n"; + return undef; } my $extname = metadataLookupStr($extname_rules, $name); # File name unless (defined $extname) { - carp "Can't find $name within EXTNAME.RULES in camera configuration.\n"; - return undef; + carp "Can't find $name within EXTNAME.RULES in camera configuration.\n"; + return undef; } if ($extname =~ /\{CHIP\.NAME\}/) { - unless (defined $component) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); - } - $extname =~ s/\{CHIP\.NAME\}/$component/; + unless (defined $component) { + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); + } + $extname =~ s/\{CHIP\.NAME\}/$component/; } @@ -880,22 +880,22 @@ sub tessellation_catdir { - my $self = shift; # Configuration object - my $tess_id = shift; # Tessellation identifier + my $self = shift; # Configuration object + my $tess_id = shift; # Tessellation identifier unless (defined $self and defined $self->{_siteConfig} and defined $tess_id) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } my $tessellations = metadataLookupMD($self->{_siteConfig}, 'TESSELLATIONS'); # Tessellations unless (defined $tessellations) { - carp "Can't find TESSELLATIONS in site configuration.\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Can't find TESSELLATIONS in site configuration.\n"; + exit($PS_EXIT_CONFIG_ERROR); } my $catdir = metadataLookupStr($tessellations, $tess_id); unless (defined $catdir) { - print "Can't find tessellation identifier $tess_id in TESSELLATIONS in site configuration, assuming it is a filename.\n"; - return $tess_id; + print "Can't find tessellation identifier $tess_id in TESSELLATIONS in site configuration, assuming it is a filename.\n"; + return $tess_id; } @@ -903,6 +903,6 @@ my $scheme = file_scheme($catdir); # The scheme, e.g., file, path, neb if (defined $scheme and lc($scheme) eq 'neb') { - carp "Tessellation $tess_id refers to a Nebulous path: $catdir\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Tessellation $tess_id refers to a Nebulous path: $catdir\n"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -914,22 +914,22 @@ sub dvo_catdir { - my $self = shift; # Configuration object - my $dvodb = shift; # DVO db identifier + my $self = shift; # Configuration object + my $dvodb = shift; # DVO db identifier unless (defined $self and defined $self->{_siteConfig} and defined $dvodb) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } my $catdirs = metadataLookupMD($self->{_siteConfig}, 'DVO.CATDIRS'); # Tessellations unless (defined $catdirs) { - carp "Can't find DVO.CATDIRS in site configuration.\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Can't find DVO.CATDIRS in site configuration.\n"; + exit($PS_EXIT_CONFIG_ERROR); } my $catdir = metadataLookupStr($catdirs, $dvodb); unless (defined $catdir) { - print "Can't find dvodb identifier $dvodb in DVO.CATDIR in site configuration, assuming filename\n"; - return $dvodb; + print "Can't find dvodb identifier $dvodb in DVO.CATDIR in site configuration, assuming filename\n"; + return $dvodb; } @@ -937,6 +937,6 @@ my $scheme = file_scheme($catdir); # The scheme, e.g., file, path, neb if (defined $scheme and lc($scheme) eq 'neb') { - carp "DVO catdir $dvodb refers to a Nebulous path: $catdir\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "DVO catdir $dvodb refers to a Nebulous path: $catdir\n"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -947,22 +947,22 @@ sub psastro_catdir { - my $self = shift; # Configuration object - my $dvodb = shift; # DVO db identifier + my $self = shift; # Configuration object + my $dvodb = shift; # DVO db identifier unless (defined $self and defined $self->{_siteConfig} and defined $dvodb) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } my $catdirs = metadataLookupMD($self->{_siteConfig}, 'PSASTRO.CATDIRS'); # Tessellations unless (defined $catdirs) { - carp "Can't find PSASTRO.CATDIRS in site configuration.\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "Can't find PSASTRO.CATDIRS in site configuration.\n"; + exit($PS_EXIT_CONFIG_ERROR); } my $catdir = metadataLookupStr($catdirs, $dvodb); unless (defined $catdir) { - print "Can't find dvodb identifier $dvodb in PSASTRO.CATDIR in site configuration, assuming filename.\n"; - return $dvodb; + print "Can't find dvodb identifier $dvodb in PSASTRO.CATDIR in site configuration, assuming filename.\n"; + return $dvodb; } @@ -970,6 +970,6 @@ my $scheme = file_scheme($catdir); # The scheme, e.g., file, path, neb if (defined $scheme and lc($scheme) eq 'neb') { - carp "PSASTRO catdir $dvodb refers to a Nebulous path: $catdir\n"; - exit($PS_EXIT_CONFIG_ERROR); + carp "PSASTRO catdir $dvodb refers to a Nebulous path: $catdir\n"; + exit($PS_EXIT_CONFIG_ERROR); } @@ -980,21 +980,21 @@ sub dvo_cameradir { - my $self = shift; # Configuration object + my $self = shift; # Configuration object unless (defined $self) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } my $camera = $self->{camera}; # Camera configuration unless (defined $camera) { - carp "Camera has not yet been defined.\n"; - return undef; + carp "Camera has not yet been defined.\n"; + return undef; } my $dir = metadataLookupStr($camera, "DVO.CAMERADIR"); # Directory of interest unless (defined $dir) { - carp "Can't find DVO.CAMERADIR in camera configuration.\n"; - return undef; + carp "Can't find DVO.CAMERADIR in camera configuration.\n"; + return undef; } @@ -1006,61 +1006,61 @@ sub reduction { - my $self = shift; # Configuration object - my $reduction = shift; # Reduction class - my $name = shift; # Symbolic name of recipe + my $self = shift; # Configuration object + my $reduction = shift; # Reduction class + my $name = shift; # Symbolic name of recipe unless (defined $self and defined $reduction and defined $name) { - carp "Programming error --- inputs undefined"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error --- inputs undefined"; + exit($PS_EXIT_PROG_ERROR); } my $reductionClasses; if (defined $self->{reductionClasses}) { - $reductionClasses = $self->{reductionClasses}; + $reductionClasses = $self->{reductionClasses}; } else { - # load and save the reductionClasses table - - # need to have a valid camear - my $camera = $self->{camera}; # Camera configuration - unless (defined $camera) { - carp "Camera has not yet been defined.\n"; - return undef; - } - - $reductionClasses = metadataLookup($camera, 'REDUCTION'); # File rules - - unless (defined $reductionClasses) { - carp "Can't find REDUCTION list in camera configuration.\n"; - return undef; - } - - if ($reductionClasses->{class} eq "scalar" and $reductionClasses->{type} eq "STR") { - # Allow indirection to a file - my $filename = $self->_find_config($reductionClasses->{value}); # Resolved filename - # Read the file - my $file; # File handle - unless (open $file, $filename) { - carp "Unable to open reductionClasses file $filename: $!"; - exit($PS_EXIT_CONFIG_ERROR); - } - my @contents = <$file>; - close $file; - $reductionClasses = $parser->parse( join '', @contents); - } elsif ($reductionClasses->{class} eq "metadata") { - $reductionClasses = $reductionClasses->{value}; - } else { - carp "Can't interpret REDUCTIONS in camera configuration.\n"; - return undef; - } - $self->{reductionClasses} = $reductionClasses; + # load and save the reductionClasses table + + # need to have a valid camear + my $camera = $self->{camera}; # Camera configuration + unless (defined $camera) { + carp "Camera has not yet been defined.\n"; + return undef; + } + + $reductionClasses = metadataLookup($camera, 'REDUCTION'); # File rules + + unless (defined $reductionClasses) { + carp "Can't find REDUCTION list in camera configuration.\n"; + return undef; + } + + if ($reductionClasses->{class} eq "scalar" and $reductionClasses->{type} eq "STR") { + # Allow indirection to a file + my $filename = $self->_find_config($reductionClasses->{value}); # Resolved filename + # Read the file + my $file; # File handle + unless (open $file, $filename) { + carp "Unable to open reductionClasses file $filename: $!"; + exit($PS_EXIT_CONFIG_ERROR); + } + my @contents = <$file>; + close $file; + $reductionClasses = $parser->parse( join '', @contents); + } elsif ($reductionClasses->{class} eq "metadata") { + $reductionClasses = $reductionClasses->{value}; + } else { + carp "Can't interpret REDUCTIONS in camera configuration.\n"; + return undef; + } + $self->{reductionClasses} = $reductionClasses; } my $class = metadataLookupMD($reductionClasses, $reduction) or # Class of interest - (carp "Can't find $reduction in REDUCTION in camera configuration.\n" and - exit($PS_EXIT_CONFIG_ERROR)); + (carp "Can't find $reduction in REDUCTION in camera configuration.\n" and + exit($PS_EXIT_CONFIG_ERROR)); my $actual = metadataLookupStr($class, $name) or # The actual recipe name of interest - (carp "Can't find $name in $class in REDUCTION in camera configuration.\n" and - exit($PS_EXIT_CONFIG_ERROR)); + (carp "Can't find $name in $class in REDUCTION in camera configuration.\n" and + exit($PS_EXIT_CONFIG_ERROR)); return $actual; @@ -1069,13 +1069,13 @@ sub skycell_file { - my $self = shift; # Configuration object - my $tess_id = shift; # Tessellation identifier - my $skycell_id = shift; # Skycell identifier - my $outname = shift; # Output name - my $verbose = shift; # Verbose? + my $self = shift; # Configuration object + my $tess_id = shift; # Tessellation identifier + my $skycell_id = shift; # Skycell identifier + my $outname = shift; # Output name + my $verbose = shift; # Verbose? unless (defined $self and defined $tess_id and defined $skycell_id and defined $outname) { - carp "Input parameters not defined"; - return 0; + carp "Input parameters not defined"; + return 0; } @@ -1084,15 +1084,15 @@ my $tess_dir = $self->tessellation_catdir( $tess_id ); # Tessellation catdir for DVO unless (defined $tess_dir) { - carp "Can't get list of tessellations."; - return 0; + carp "Can't get list of tessellations."; + return 0; } $tess_dir = $self->convert_filename_absolute( $tess_dir ); unless ($self->file_exists( $outname )) { - my $outnameResolved = $self->file_create( $outname ); # Resolved filename, for Nebulous - my $command = "$dvoImageExtract -D CATDIR $tess_dir $skycell_id -o $outnameResolved"; - my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = - run(command => $command, verbose => $verbose); - die "Unable to perform dvoImageExtract for $tess_id $skycell_id\n" unless ($success and $self->file_exists( $outname )); + my $outnameResolved = $self->file_create( $outname ); # Resolved filename, for Nebulous + my $command = "$dvoImageExtract -D CATDIR $tess_dir $skycell_id -o $outnameResolved"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + die "Unable to perform dvoImageExtract for $tess_id $skycell_id\n" unless ($success and $self->file_exists( $outname )); } @@ -1103,16 +1103,16 @@ sub _interpolate_env { - my $dir = shift; # Directory of interest + my $dir = shift; # Directory of interest return undef unless defined $dir; while ($dir =~ /\$\{?(\w*)[\}\/:]?/) { - my $name = $1; # Environment variable name - my $value = $ENV{$name}; # Environment variable value - unless (defined $value) { - carp "Unable to find environment variable $name"; - exit($PS_EXIT_SYS_ERROR); - } - $dir =~ s/\$\{?$name\}?/$value\//; + my $name = $1; # Environment variable name + my $value = $ENV{$name}; # Environment variable value + unless (defined $value) { + carp "Unable to find environment variable $name"; + exit($PS_EXIT_SYS_ERROR); + } + $dir =~ s/\$\{?$name\}?/$value\//; } return $dir; @@ -1121,17 +1121,17 @@ sub metadataLookup { - my $mdc = shift; # Metadata config to look up - my $name = shift; # Name of item to look up + my $mdc = shift; # Metadata config to look up + my $name = shift; # Name of item to look up unless (defined $mdc and defined $name) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } # Iterate through the array of hashes foreach my $item (@$mdc) { - if ($item->{name} eq $name) { - return $item; - } + if ($item->{name} eq $name) { + return $item; + } } @@ -1146,5 +1146,5 @@ my $item = metadataLookup(@_); return undef if not defined $item; - my $name = shift; # Name of item + my $name = shift; # Name of item carp "$name within metadata is not of type STR.\n" unless $item->{type} eq "STR"; return $item->{value}; @@ -1156,5 +1156,5 @@ my $item = metadataLookup(@_); return undef if not defined $item; - my $name = shift; # Name of item + my $name = shift; # Name of item carp "$name within metadata is not of type METADATA.\n" unless $item->{class} eq "metadata"; return $item->{value}; @@ -1166,5 +1166,5 @@ my $item = metadataLookup(@_); return undef if not defined $item; - my $name = shift; # Name of item + my $name = shift; # Name of item carp "$name within metadata is not of type BOOL.\n" unless $item->{type} eq "BOOL"; return $item->{value}; @@ -1174,25 +1174,25 @@ sub _mdLookupMDwithRedirect { - my $mdc = shift; # Metadata config to look up - my $name = shift; # Name of item to look ip + my $mdc = shift; # Metadata config to look up + my $name = shift; # Name of item to look ip unless (defined $mdc and defined $name) { - carp "Programming error"; - exit($PS_EXIT_PROG_ERROR); + carp "Programming error"; + exit($PS_EXIT_PROG_ERROR); } # Iterate through the array of hashes foreach my $item (@$mdc) { - if ($item->{name} eq $name) { - if ($item->{class} eq "metadata") { - return $item->{value}; - } - if ($item->{class} eq "scalar" and $item->{type} eq "STR") { - # Redirect - return _mdLookupMDwithRedirect($mdc, $item->{value}); - } - carp "$name within metadata is not of type METADATA or STR.\n"; - return undef; - } + if ($item->{name} eq $name) { + if ($item->{class} eq "metadata") { + return $item->{value}; + } + if ($item->{class} eq "scalar" and $item->{type} eq "STR") { + # Redirect + return _mdLookupMDwithRedirect($mdc, $item->{value}); + } + carp "$name within metadata is not of type METADATA or STR.\n"; + return undef; + } }