Changeset 9504 for trunk/PS-IPP-Config/lib/PS/IPP/Config.pm

Timestamp:

Oct 12, 2006, 10:12:14 AM (20 years ago)

Author:

Paul Price

Message:

Adding rejection settings for detrend creation. Involves looking up
the camera configuration given a camera name (need to search the path)
and getting the line that matches the detrend type and filter.

File:

• trunk/PS-IPP-Config/lib/PS/IPP/Config.pm (modified) (6 diffs)

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

@@ -1 +1 @@
 # Copyright (c) 2006  Paul Price, Joshua Hoblitt
 #
-# $Id: Config.pm,v 1.1 2006-10-04 01:45:47 price Exp $
+# $Id: Config.pm,v 1.2 2006-10-12 20:12:14 price Exp $
 
 package PS::IPP::Config;
@@ -11 +11 @@
 
 use Carp qw( carp croak );
-use PS::IPP::Metadata::Config;
+use File::Spec;
+use PS::IPP::Metadata::Config 0.07;
 use Getopt::Long qw( GetOptions :config gnu_getopt pass_through ); # Set pass_through so we don't kill @ARGV
 
 use base qw( Class::Accessor::Fast );
 __PACKAGE__->mk_accessors( qw( path workdir ) );
+
+our $parser = PS::IPP::Metadata::Config->new; # Metadata parser
+$parser->overwrite(0);          # Turn off overwrite
 
 #$::RD_TRACE = 1;
@@ -24 +28 @@
 sub new {
     my $class = shift;          # Class name
+    my $camera = shift;         # Camera name
 
     # Get location of ipprc file
@@ -35 +40 @@
     close $file;
 
-    my $parser = PS::IPP::Metadata::Config->new; # Parser for ipprc file
     my $mdc = $parser->parse( join '', @contents); # The parsed metadata config
 
     my $path = _mdLookupStr($mdc, 'PATH'); # The path
     my $workdir = _mdLookupStr($mdc, 'WORKDIR'); # The working directory
-
     croak "PATH is not set in $name\n" unless defined $path;
     croak "WORKDIR is not set in $name\n" unless defined $workdir;
@@ -47 +50 @@
         path => $path,          # Path
         workdir => $workdir,    # Working directory
+        camera => undef,        # Camera configuration
         _ipprc => $mdc          # The parsed configuration
         };
+    bless $self, $class;
 
-    bless $self, $class;
+    $self->define_camera($camera) if defined $camera;
+
     return $self;
-
 }
 
-# Lookup the metadata, checking the type
+# Define a camera to use
+sub define_camera
+{
+    my $self = shift;           # Configuration object
+    my $name = shift;           # Camera name
+
+    my $camera_list = _mdLookupMD($self->{_ipprc}, 'CAMERAS'); # List of cameras
+    my $filename = _mdLookupStr($camera_list, $name); # Filename of camera configuration
+    my @path = split /:/, $self->{path}; # List of paths to try
+    my $found;                  # Found it?
+    foreach my $path (@path) {
+        my $test = File::Spec->rel2abs( $filename, $path );
+        if (-f $test) {
+            $found = $test;
+            last;
+        }
+    }
+    croak "Unable to find camera configuration file $filename\n" if not defined $found;
+
+    # Read the file
+    open my $file, $found or croak "Unable to open camera configuration file $found: $!";
+    my @contents = <$file>;
+    close $file;
+    $self->{camera} = $parser->parse( join '', @contents); # The parsed metadata config
+
+    return defined $self->{camera};
+}
+
+
+# Return a rejection limit from the camera configuration
+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 $camera = $self->{camera}; # Camera configuration
+    unless (defined $camera) {
+        carp "Camera has not yet been defined.\n";
+        return undef;
+    }
+
+    my $rejection = _mdLookupMD($camera, 'REJECTION');  # Rejection list
+    unless (defined $rejection) {
+        carp "Can't find REJECTION list in camera configuration.\n";
+        return undef;
+    }
+
+  TYPES: foreach my $item (@$rejection) {
+      if (lc($item->{name}) eq $type) {
+          croak "$name within REJECTION is not of type METADATA" unless $item->{class} eq "metadata";
+          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 REJECTION list for $type.\n";
+          return undef;
+      }
+  }
+
+    if (not defined $filter) {
+        carp "Unable to find type $type with no FILTER in REJECTION list.\n";
+    } else {
+        carp "Unable to find type $type with FILTER $filter in REJECTION list.\n";
+    }
+    return undef;
+}
+
+
+# Lookup the metadata, checking the type is STR
 sub _mdLookupStr
 {
@@ -73 +161 @@
 }
 
+# Lookup the metadata, checking the type is MD
+sub _mdLookupMD
+{
+    my $mdc = shift;            # Metadata config to look up
+    my $name = shift;           # Name of item to look ip
+
+    # Iterate through the array of hashes
+    foreach my $item (@$mdc) {
+        if ($item->{name} eq $name) {
+            carp "$name within metadata is not of type METADATA.\n" unless $item->{class} eq "metadata";
+            return $item->{value};
+        }
+    }
+
+    carp "Unable to find $name within metadata.\n";
+    return undef;
+}
+
 
 1;