IPP Software Navigation Tools IPP Links Communication Pan-STARRS Links

Ignore:
Timestamp:
May 18, 2010, 12:49:05 PM (16 years ago)
Author:
eugene
Message:

merging changes from trunk into branches/pap

Location:
branches/pap
Files:
49 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/pap

  • branches/pap/ippScripts/scripts/addstar_run.pl

    r26112 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use DateTime;

  • branches/pap/ippScripts/scripts/automate_stacks.pl

    r27631 r28003  
    5656# Grab options
    5757my ( $date, $camera, $dbname, $logfile, $verbose, $manual);
    58 my ( $help, $isburning, $force_stack_count, $test_mode, $this_target_only, $this_filter_only);
     58my ( $help, $isburning, $force_stack_count, $test_mode, $this_target_only, $this_filter_only, $check_mode);
    5959my ( $check_registration, $define_burntool, $queue_burntool, $check_chips, $queue_chips);
    6060my ( $check_stacks, $queue_stacks, $check_diffs, $queue_diffs, $clean_old);
    … …  
    6767    'logfile=s'            => \$logfile,
    6868    'verbose'              => \$verbose,
     69    'debug'                => \$debug,
    6970    'isburning'            => \$isburning,
    7071    'force_stack_count'    => \$force_stack_count,
     72    'check'                => \$check_mode,
    7173    'test_mode'            => \$test_mode,
    7274    'this_target_only=s'   => \$this_target_only,
    … …  
    115117    defined $queue_chips or defined $queue_stacks or
    116118    defined $check_chips or defined $check_stacks or
    117     defined $test_mode or defined $clean_old;
     119    defined $test_mode or defined $clean_old or defined $check_mode;
    118120
    119121# Configurable parameters from our config file.
    … …  
    126128my %stackable_list = ();
    127129my %reduction_class = ();
    128 my $retention_time = 9000;
    129 
     130my %clean_commands = ();
     131my %clean_retention = ();
     132my %noclean_list = ();
    130133# Grab the configuration data.
    131134my $conf_cmd = "$ppConfigDump -dump-recipe NIGHTLY_SCIENCE -";
    … …  
    140143my $metadata = $mdcParser->parse(join "", @$stdout_buf);
    141144foreach my $entry (@{ $metadata }) {
    142     if (${ $entry }{name} eq 'RETENTION_TIME') {
    143         $retention_time = ${ $entry }{value};
    144     }
     145    if (@{ $entry }{name} eq 'CLEAN_MODES') {
     146        my @mode_data = @{ ${ $entry }{value} };
     147        my $this_mode = '';
     148        foreach my $mentry (@mode_data) {
     149            if (${ $mentry }{name} eq 'MODE') {
     150                $this_mode = ${ $mentry }{value};
     151            }
     152            elsif (${ $mentry }{name} eq 'COMMAND') {
     153                $clean_commands{$this_mode} = ${ $mentry }{value};
     154            }
     155            elsif (${ $mentry }{name} eq 'RETENTION_TIME') {
     156                $clean_retention{$this_mode} = ${ $mentry }{value};
     157            }
     158        }
     159    }
     160#    if (${ $entry }{name} eq 'RETENTION_TIME') {
     161#        $retention_time = ${ $entry }{value};
     162#    }
    145163    elsif (${ $entry }{name} eq 'FILTERS') {
    146164        push @filter_list, ${ $entry }{value};
    … …  
    172190                $reduction_class{$this_target} = ${ $tentry }{value};
    173191            }
     192            elsif (${ $tentry }{name} eq 'NOCLEAN') {
     193                $noclean_list{$this_target} = ${ $tentry }{value};
     194            }
    174195        }
    175196    }
    … …  
    217238if (defined($test_mode)) {
    218239    $debug = 1;
    219 }
    220 
    221 if (defined($check_registration) || defined($test_mode)) {
     240    my $z;
     241    foreach $z (@target_list) {
     242        print "TARGET: $z $tessID_list{$z} $obsmode_list{$z} $object_list{$z} $comment_list{$z} $stackable_list{$z} $reduction_class{$z}\n";
     243    }
     244    foreach $z (@filter_list) {
     245        print "FILTER: $z\n";
     246    }
     247    foreach $z (keys (%clean_commands)) {
     248        print "CLEAN: $z $clean_commands{$z} $clean_retention{$z}\n";
     249    }
     250   
     251}
     252
     253if (defined($check_registration) || defined($test_mode) || defined($check_mode)) {
    222254    $metadata_out{nsState} = 'NEW';
    223255    my ($Nsummit_exp,$Nfaults) = check_summit_copy($date);
    224256    return_metadata($date);
    225     unless (defined($test_mode)) { exit(0); }
     257    unless (defined($test_mode) || defined($check_mode)) { exit(0); }
    226258}
    227259if (defined($define_burntool) || defined($test_mode)) {
    … …  
    236268    unless (defined($test_mode)) { exit(0); }
    237269}
    238 if (defined($check_chips) || defined($test_mode)) {
     270if (defined($check_chips) || defined($test_mode) || defined($check_mode)) {
    239271    $metadata_out{nsState} = 'QUEUECHIPS';
    240272    &execute_chips($date,"pretend");
    … …  
    243275    }
    244276    return_metadata($date);
    245     unless (defined($test_mode)) { exit(0); }
     277    unless (defined($test_mode) || defined($check_mode)) { exit(0); }
    246278}
    247279if (defined($queue_chips)) {
    … …  
    251283    exit(0);
    252284}
    253 if (defined($check_stacks) || defined($test_mode)) {
     285if (defined($check_stacks) || defined($test_mode) || defined($check_mode)) {
    254286    $metadata_out{nsState} = 'TOWARP';
    255287    &execute_stacks($date,"pretend");
    … …  
    258290    }
    259291    return_metadata($date);
    260     unless (defined($test_mode)) { exit(0); }
     292    unless (defined($test_mode) || defined($check_mode)) { exit(0); }
    261293}
    262294if (defined($queue_stacks)) {
    263295    $metadata_out{nsState} = 'STACKING';
    264296    &execute_stacks($date);
     297    if ($metadata_out{nsState} eq 'QUEUESTACKING') {
     298        $metadata_out{nsState} = 'STACKING_POSSIBLE_ERROR';
     299    }
    265300    return_metadata($date);
    266301    exit(0);
    … …  
    420455    }
    421456
    422     if ($#{ $stderr_buf } > -1) {
    423         $metadata_out{nsState} = 'ERROR';
    424         return(1);
    425     }
     457#    if ($#{ $stderr_buf } > -1) {
     458#        $metadata_out{nsState} = 'ERROR';
     459#        return(1);
     460#    }
    426461
    427462    my $N = 0;
    … …  
    429464    foreach my $row (@burntool_entries) {
    430465        my ($trash,$start,$end);
    431         ($trash,$trash,$start,$end) = (split /\s+/,$row);
    432 
     466        (undef,$trash,$start,$end) = (split /\s+/,$row);
     467        if ($trash ne 'burntool') {
     468            $metadata_out{nsState} = 'ERROR';
     469            return(1);
     470        }
    433471        for (my $class_counter = 0; $class_counter < 60; $class_counter++) {
    434472            $metadata_out{"bt${N}Begin"} = $start;
    … …  
    650688    my @input_exposures = split /\n/, (join '', @$stdout_buf);
    651689    foreach my $entry (@input_exposures) {
    652         my ($skycell, @trash) = split /\s+/, $entry;
     690        my ($warp_tess_id,$skycell, @trash) = split /\s+/, $entry;
    653691        @trash = verify_uniqueness_stack($skycell,$date,$target,$filter);
    654692        $Nalready += $trash[0];
    … …  
    681719                my ($Nexposures,$NprocChips,$NprocWarps,$Nalready) = pre_stack_queue($date,$target,$filter);
    682720                if ((!defined($force_stack_count))&&($NprocChips != $NprocWarps)) { # This makes me sad. :(
    683                     # print STDERR "execute_stacks: Target $target on $date is not fully processed. ($NprocChips $NprocWarps)\n";
     721                    if ($debug == 1) {
     722                        print STDERR "execute_stacks: Target $target on $date is not fully processed. ($NprocChips $NprocWarps)\n";
     723                    }
    684724                    $metadata_out{nsState} = 'FORCETOWARP';
    685725                    next;
    686726                }
    687727                if ($Nexposures == 0) {
    688                     # print STDERR "execute_stacks: Target $target in filter $filter on $date has no exposures.\n";
     728                    if ($debug == 1) {
     729                        print STDERR "execute_stacks: Target $target in filter $filter on $date has no exposures.\n";
     730                    }
    689731                    next;
    690732                }
    691733                if ($Nalready != 0) {
    692                     # print STDERR "execute_stacks: Not queueing $target in filter $filter on $date due to already existing stacks.\n";
     734                    if ($debug == 1) {
     735                        print STDERR "execute_stacks: Not queueing $target in filter $filter on $date due to already existing stacks.\n";
     736                    }
     737                    unless ($metadata_out{nsState} eq 'FORCETOWARP') {
     738                        $metadata_out{nsState} = 'STACKING';
     739                    }
    693740                    next;
    694741                }
    695                 unless ($metadata_out{nsState} eq 'FORCETOWARP') {
     742                unless (($metadata_out{nsState} eq 'FORCETOWARP')||($metadata_out{nsState} eq 'STACKING')) {
    696743                    $metadata_out{nsState} = 'QUEUESTACKS';
    697744                }
    698745                unless(defined($pretend)) {
    699                     # print STDERR "execute_stacks: Target $target in filter $filter on $date has exposures and will be queued.\n";
     746                    if ($debug == 1) {
     747                        print STDERR "execute_stacks: Target $target in filter $filter on $date has exposures and will be queued.\n";
     748                    }
    700749                    stack_queue($date,$target,$filter);
    701750                }
    … …  
    716765    my $date = shift;
    717766    my $target = shift;
     767    my $mode = shift;
     768
     769    my $command = $clean_commands{$mode};
     770    my $retention_time = $clean_retention{$mode};
    718771
    719772    my ($year,$month,$day) = split /-/,$date;
    … …  
    725778
    726779    my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($cleaning_date,$target);
    727 
    728     my $args .= " -dbname gpc1 -updaterun -set_state goto_cleaned -state full -data_group $data_group ";
     780    my $args = $command;
     781    $args .= " -dbname gpc1 -updaterun -set_state goto_cleaned -state full -set_label goto_cleaned -label $label -data_group $data_group ";
    729782    if ($debug == 1) {
    730783        $args .= ' -pretend ';
    … …  
    737790    my $pretend = shift;
    738791
    739     foreach my $target (@target_list) {
    740         my ($cleaning_date,$args) = construct_cleantool_args($date,$target);
    741 
    742         my $command = $chiptool . $args;
    743         print STDERR "$command\n";
    744         if (!(defined($pretend) || $debug == 1)) {
     792    foreach my $mode (keys (%clean_commands)) {
     793        foreach my $target (@target_list) {
     794            if (exists($noclean_list{$target})) {
     795                next;
     796            }
     797            my ($cleaning_date,$command) = construct_cleantool_args($date,$target,$mode);
     798
     799            print STDERR "$command\n";
     800            if (!(defined($pretend) || $debug == 1)) {
    745801#           print STDERR "BEAR IS DRIVING!?\n";
    746             my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    747                 run ( command => $command, verbose => $verbose );
    748             unless ($success) {
    749                 $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    750                 &my_die("Unable to perform stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR);
    751             }
    752         }
    753         $command = $warptool . $args;
    754         print STDERR "$command\n";
    755         if (!(defined($pretend) || $debug == 1)) {
    756 #           print STDERR "BEAR IS DRIVING $pretend $debug!?\n";
    757             my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    758                 run ( command => $command, verbose => $verbose );
    759             unless ($success) {
    760                 $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    761                 &my_die("Unable to perform stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR);
    762             }
    763         }
     802                my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     803                    run ( command => $command, verbose => $verbose );
     804                unless ($success) {
     805                    $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     806                    &my_die("Unable to perform stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR);
     807                }
     808            }
     809        }
    764810    }
    765811    return(0);

  • branches/pap/ippScripts/scripts/calibrate_dvo.pl

    r23186 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/camera_exp.pl

    r27555 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use DateTime;

  • branches/pap/ippScripts/scripts/chip_imfile.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use DateTime;

  • branches/pap/ippScripts/scripts/detrend_correct_imfile.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
    12 print "command: @ARGV\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1313
    1414use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/detrend_norm_apply.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/detrend_norm_calc.pl

    r26514 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    5657
    5758# force det_type to be upper-case in this script
    58 my $det_type = uc($det_type);
     59$det_type = uc($det_type);
    5960
    6061my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $det_id, $iter, $PS_EXIT_CONFIG_ERROR ); # IPP configuration

  • branches/pap/ippScripts/scripts/detrend_norm_exp.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/detrend_process_exp.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/detrend_process_imfile.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/detrend_reject_exp.pl

    r24764 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/detrend_resid_imfile.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/detrend_stack.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/diff_skycell.pl

    r27596 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
     9my $date = `date`;
    910print "\n\n";
    10 print "Starting script $0 on $host\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1112
    1213use DateTime;
    … …  
    398399            $command .= " -hostname $host" if defined $host;
    399400            $command .= " -path_base $outroot" if defined $outroot;
    400             $command .= " -dbname $dbname" if defined $dbname;
    401401        } else {
    402402            $command .= " -updatediffskyfile";
    403403        }
     404        $command .= " -dbname $dbname" if defined $dbname;
    404405        run(command => $command, verbose => $verbose);
    405406    }

  • branches/pap/ippScripts/scripts/dist_advancerun.pl

    r27016 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    174175        }
    175176        &my_die("unable to find path",  $dist_id, $PS_EXIT_UNKNOWN_ERROR) if !$path;
    176         my $component_dir = find_componentdir($destdir, $path); 
     177        my $component_dir = find_componentdir($destdir, $path);
    177178#        print MANIFEST "$component METADATA\n";
    178179        print MANIFEST "\t" , "$component", "\tSTR\t", $component_dir, "\n";
    179180    }
    180181    print MANIFEST "END\n\n";
    181     close MANIFEST or 
     182    close MANIFEST or
    182183        &my_die("Unable to close dirinfo file $dirinfo",  $dist_id, $PS_EXIT_UNKNOWN_ERROR);
    183184}

  • branches/pap/ippScripts/scripts/dist_bundle.pl

    r27449 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011# print "\n\n";
    11 # print "Starting script $0 on $host\n\n";
     12# print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    115116
    116117# Get the list of data products for this component
    117 # note: We my_die in get_file_list if something goes wrong. 
     118# note: We my_die in get_file_list if something goes wrong.
    118119
    119120my $file_list = get_file_list($stage, $component, $path_base, $clean);
    … …  
    193194    $num_files++;
    194195    if ($image_type && $nan_masked_pixels) {
    195         # save the 
     196        # save the
    196197        if ($image_type eq 'image') {
    197198            $image = $file_name;
    … …  
    222223    # One last check as to whether magic has been applied to the inputs
    223224
    224     # Note: the sql for disttool -pendingcomponent won't select a component that 
     225    # Note: the sql for disttool -pendingcomponent won't select a component that
    225226    # requires magic and hasn't been magicked, but we check again here
    226227
    … …  
    327328### Pau.
    328329
    329 # return the image type (image, mask, or variance) if this file rule refers to 
     330# return the image type (image, mask, or variance) if this file rule refers to
    330331# one of the big fits files that are not included in a clean distribution
    331332sub get_image_type {
    … …  
    360361sub open_with_retries {
    361362    my $name = shift;
    362    
     363
    363364    my $tries = 1;
    364365    my $max_tries = 5;
    … …  
    372373        }
    373374    }
    374    
     375
    375376    &my_die("failed to open $name after $max_tries tries\n", $component,
    376377                    $PS_EXIT_DATA_ERROR) if (!$opened);

  • branches/pap/ippScripts/scripts/dist_cleanup.pl

    r26096 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/dist_component.pl

    r27449 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/dist_defineruns.pl

    r26998 r28003  
    1111use Sys::Hostname;
    1212my $host = hostname();
     13my $date = `date`;
    1314print "\n\n";
    14 print "Starting script $0 on $host\n\n";
     15print "Starting script $0 on $host at $date\n\n";
    1516
    1617use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/dist_make_fileset.pl

    r27014 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    4647           'dist_id=s'      => \$dist_id,    # distribution run identifier
    4748           'dist_dir=s'     => \$dist_dir,   # directory containing dist run outputs
    48            'target_id=s'    => \$target_id,  # 
     49           'target_id=s'    => \$target_id,  #
    4950           'stage=s'        => \$stage,      # raw, chip, camera, fake, warp, stack, or diff
    5051           'stage_id=s'     => \$stage_id,   # exp_id, chip_id, etc.
    … …  
    209210    my $dsn = "DBI:mysql:host=$dbserver;database=$dbname";
    210211
    211     my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) 
     212    my $dbh = DBI->connect($dsn, $dbuser, $dbpassword)
    212213        or die "Cannot connect to database.\n";
    213214
    … …  
    227228
    228229    #
    229     # we are a long ways away from the rawExp in the pipeline. Rather than do some 
     230    # we are a long ways away from the rawExp in the pipeline. Rather than do some
    230231    # very long joins in disttool, we look up the exp_name in the database using DBI
    231232    #
    232233    my $dbh = getDBHandle($ipprc, $dbname);
    233234
    234     my $query; 
     235    my $query;
    235236
    236237    if ($stage eq 'raw') {

  • branches/pap/ippScripts/scripts/dqstats_bundle.pl

    r27308 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use DateTime;
    … …  
    3738my ( $dqstats_id, $camera, $uri, $dbname, $verbose, $no_update, $no_op, $redirect, $save_temps);
    3839GetOptions(
    39            'dqstats_id=s'    => \$dqstats_id, # dqstatsrun ID
    40            'camera|c=s'      => \$camera,  # camera
    41            'dbname|d=s'      => \$dbname,  # database name
    42            'uri=s'           => \$uri, # output file destination
    43            'verbose'         => \$verbose, # print to stdout
    44            'no-update'       => \$no_update, # Update the database
    45            'no-op'           => \$no_op,   # don't do the operations
    46            'redirect-output' => \$redirect,
    47            'save-temps'      => \$save_temps, # save temporary files
    48            ) or pod2usage( 2 );
     40           'dqstats_id=s'    => \$dqstats_id, # dqstatsrun ID
     41           'camera|c=s'      => \$camera,  # camera
     42           'dbname|d=s'      => \$dbname,  # database name
     43           'uri=s'           => \$uri, # output file destination
     44           'verbose'         => \$verbose, # print to stdout
     45           'no-update'       => \$no_update, # Update the database
     46           'no-op'           => \$no_op,   # don't do the operations
     47           'redirect-output' => \$redirect,
     48           'save-temps'      => \$save_temps, # save temporary files
     49           ) or pod2usage( 2 );
    4950
    5051pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
    5152pod2usage( -msg => "Required options --dqstats_id --camera",
    52            -exitval => 3,
    53            ) unless
     53           -exitval => 3,
     54           ) unless
    5455    defined $dqstats_id and
    5556    defined $camera;
    5657
    57 my $ipprc = PS::IPP::Config->new( $camera ) 
     58my $ipprc = PS::IPP::Config->new( $camera )
    5859    or my_die( "Unable to set up", $dqstats_id, $PS_EXIT_CONFIG_ERROR ); # IPP config
    59 #my $logDest = $ipprc->filename("LOG.EXP", $uri) 
     60#my $logDest = $ipprc->filename("LOG.EXP", $uri)
    6061#    or my_die("Missing entry from camera config", $dqstats_id, $PS_EXIT_CONFIG_ERROR);
    6162
    6263if ($redirect) {
    63 #    $ipprc->redirect_output($logDest) 
    64 #       or my_die( "Unable to redirect output", $dqstats_id, $PS_EXIT_SYS_ERROR );
     64#    $ipprc->redirect_output($logDest)
     65#       or my_die( "Unable to redirect output", $dqstats_id, $PS_EXIT_SYS_ERROR );
    6566    print "\n\n";
    6667    print "Starting script $0 on $host\n\n";
    … …  
    8485unless ($no_op) {
    8586    # This bit needs to make the bundle.
    86    
     87
    8788    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    88         run(command => $bundle_command, verbose => $verbose);
     89        run(command => $bundle_command, verbose => $verbose);
    8990    unless ($success) {
    90         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    91         &my_die("Unable to create the bundle.: $error_code", $dqstats_id, $error_code);
     91        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     92        &my_die("Unable to create the bundle.: $error_code", $dqstats_id, $error_code);
    9293    }
    93    
     94
    9495    # Parse stdout_buf to get output file name
    9596    ## Begin partial
    9697    my ($tempFile, $tempName) = tempfile( "/tmp/dqstats.XXXX",
    97                                           UNLINK => !$save_temps, SUFFIX => 'dsin' );
     98                                          UNLINK => !$save_temps, SUFFIX => 'dsin' );
    9899    print $tempFile $uri . '|||notset' . "\n";
    99100
    … …  
    102103    # It can't be that simple, can it? This should probably add a fault on failure.
    103104    ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    104         run(command => $register_cmd, verbose => $verbose);
     105        run(command => $register_cmd, verbose => $verbose);
    105106    unless ($success) {
    106         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    107         &my_die("Unable to register the bundle.: $error_code", $dqstats_id, $error_code);
     107        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     108        &my_die("Unable to register the bundle.: $error_code", $dqstats_id, $error_code);
    108109    }
    109    
     110
    110111    # We no longer need the file generated by dqstatstool.
    111112    unlink($uri);
    … …  
    118119    # This bit needs to set the database state to full
    119120    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    120         run(command => $update_command, verbose => $verbose);
     121        run(command => $update_command, verbose => $verbose);
    121122    unless ($success) {
    122         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    123         warn("Unable to add result to database: $error_code\n");
    124         exit($error_code);
     123        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     124        warn("Unable to add result to database: $error_code\n");
     125        exit($error_code);
    125126    }
    126127} else {
    … …  
    139140    carp($msg);
    140141    if (defined $dqstats_id and not $no_update) {
    141         # There is no fault handling, which may be a mistake. This is where a fault coding would be.
     142        # There is no fault handling, which may be a mistake. This is where a fault coding would be.
    142143#         my $command = "$addtool -add_id $add_id";
    143144#         $command .= " -addprocessedexp";

  • branches/pap/ippScripts/scripts/fake_imfile.pl

    r23688 r28003  
    2424use Sys::Hostname;
    2525my $host = hostname();
     26my $date = `date`;
    2627print "\n\n";
    27 print "Starting script $0 on $host\n\n";
     28print "Starting script $0 on $host at $date\n\n";
    2829
    2930use DateTime;

  • branches/pap/ippScripts/scripts/flatcorr_init.pl

    r20100 r28003  
    11#!/usr/bin/env perl
    22
    3 ## USAGE:flatcorr_init.pl 
     3## USAGE:flatcorr_init.pl
    44## given dbname, dvodb, filter, time range, camera, telescope, etc?
    55## select matching images and register as a new flatcorr run
    … …  
    2424use Sys::Hostname;
    2525my $host = hostname();
     26my $date = `date`;
    2627print "\n\n";
    27 print "Starting script $0 on $host\n\n";
     28print "Starting script $0 on $host at $date\n\n";
    2829
    2930use vars qw( $VERSION );
    … …  
    6869my $caltool  = can_run('caltool')  or (warn "Can't find caltool"  and $missing_tools = 1);
    6970
    70 if ($missing_tools) { 
     71if ($missing_tools) {
    7172    warn ("Can't find required tools");
    72     exit($PS_EXIT_CONFIG_ERROR); 
     73    exit($PS_EXIT_CONFIG_ERROR);
    7374}
    7475
    … …  
    9091        cache_run(command => $command, verbose => 1);
    9192
    92     unless ($success) { 
     93    unless ($success) {
    9394        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    9495        &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RESORT", $status, $dbname);
    … …  
    99100{
    100101    foreach my $filter (@filters) {
    101         my $command = "$relphot $filter";
    102         $command .= "-D CATDIR $catdir";
    103         $command .= "-region $RAs $RAe $DECs $DECe";
    104 
    105         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    106             cache_run(command => $command, verbose => 1);
    107 
    108         unless ($success) {
    109             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    110             &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELPHOT", $status, $dbname);
    111         }
     102        my $command = "$relphot $filter";
     103        $command .= "-D CATDIR $catdir";
     104        $command .= "-region $RAs $RAe $DECs $DECe";
     105
     106        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     107            cache_run(command => $command, verbose => 1);
     108
     109        unless ($success) {
     110            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     111            &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELPHOT", $status, $dbname);
     112        }
    112113    }
    113114}
    … …  
    117118if (0) {
    118119    foreach my $filter (@filters) {
    119         my $command = "$uniphot $filter";
    120         $command .= "-D CATDIR $catdir";
    121         $command .= "-region $RAs $RAe $DECs $DECe";
    122 
    123         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    124             cache_run(command => $command, verbose => 1);
    125 
    126         unless ($success) {
    127             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    128             &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "UNIPHOT", $status, $dbname);
    129         }
     120        my $command = "$uniphot $filter";
     121        $command .= "-D CATDIR $catdir";
     122        $command .= "-region $RAs $RAe $DECs $DECe";
     123
     124        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     125            cache_run(command => $command, verbose => 1);
     126
     127        unless ($success) {
     128            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     129            &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "UNIPHOT", $status, $dbname);
     130        }
    130131    }
    131132}
    … …  
    137138
    138139    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    139         cache_run(command => $command, verbose => 1);
    140 
    141     unless ($success) { 
    142         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    143         &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELASTRO.OBJECTS", $status, $dbname);
     140        cache_run(command => $command, verbose => 1);
     141
     142    unless ($success) {
     143        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     144        &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELASTRO.OBJECTS", $status, $dbname);
    144145    }
    145146}
    … …  
    151152
    152153    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    153         cache_run(command => $command, verbose => 1);
    154 
    155     unless ($success) { 
    156         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    157         &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELASTRO.IMAGES", $status, $dbname);
     154        cache_run(command => $command, verbose => 1);
     155
     156    unless ($success) {
     157        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     158        &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELASTRO.IMAGES", $status, $dbname);
    158159    }
    159160}
    … …  
    185186    my $region    = shift;
    186187    my $last_step = shift;
    187     my $status    = shift;
    188     my $dbname    = shift;
     188    my $status    = shift;
     189    my $dbname    = shift;
    189190
    190191    carp($msg);
    191192    if (defined $dvo_id && defined $region && defined $last_step && defined $status and not $no_update) {
    192193        my $command = "$caltool -addcalrun";
    193         $command .= " -dvo_id $dvo_id";
     194        $command .= " -dvo_id $dvo_id";
    194195        $command .= " -region $region";
    195         $command .= " -last_step $last_step";
    196         $command .= " -status $status";
     196        $command .= " -last_step $last_step";
     197        $command .= " -status $status";
    197198        $command .= " -dbname $dbname" if defined $dbname;
    198199        system ($command);

  • branches/pap/ippScripts/scripts/flatcorr_proc.pl

    r25916 r28003  
    1111# dvoMakeCorr -file outgrid.fits -ref ref.fits outcorr
    1212
    13 # dettool -register -det_type FLATCORR -filelevel (level) -workdir -inst, etc 
    14 
    15 # foreach $imfile () 
     13# dettool -register -det_type FLATCORR -filelevel (level) -workdir -inst, etc
     14
     15# foreach $imfile ()
    1616#   dettool -register_imfile -uri, etc, etc
    1717
    … …  
    2323use Sys::Hostname;
    2424my $host = hostname();
     25my $date = `date`;
    2526print "\n\n";
    26 print "Starting script $0 on $host\n\n";
     27print "Starting script $0 on $host at $date\n\n";
    2728
    2829use vars qw( $VERSION );
    … …  
    7475my $addstar     = can_run('addstar')      or (warn "Can't find addstar"      and $missing_tools = 1);
    7576my $dvoMakeCorr = can_run('dvoMakeCorr')  or (warn "Can't find dvoMakeCorr"  and $missing_tools = 1);
    76 my $detselect   = can_run('detselect')    or (warn "Can't find detselect"    and $missing_tools = 1);
    77 my $dettool     = can_run('dettool')      or (warn "Can't find dettool"      and $missing_tools = 1);
    78 my $flatcorr    = can_run('flatcorr')     or (warn "Can't find flatcorr"     and $missing_tools = 1);
    79 
    80 if ($missing_tools) { 
     77my $detselect   = can_run('detselect')    or (warn "Can't find detselect"    and $missing_tools = 1);
     78my $dettool     = can_run('dettool')      or (warn "Can't find dettool"      and $missing_tools = 1);
     79my $flatcorr    = can_run('flatcorr')     or (warn "Can't find flatcorr"     and $missing_tools = 1);
     80
     81if ($missing_tools) {
    8182    warn ("Can't find required tools");
    82     exit($PS_EXIT_CONFIG_ERROR); 
     83    exit($PS_EXIT_CONFIG_ERROR);
    8384}
    8485
    … …  
    9596$ipprc->outroot_prepare($outcorr);
    9697
    97 if (not -e "$dvodb/flatcorr") { 
     98if (not -e "$dvodb/flatcorr") {
    9899    mkdir "$dvodb/flatcorr" or &my_die ("Unable to make output directory for relphot $dvodb/flatcorr", $corr_id, 3);
    99100}
    … …  
    104105my ($DECs, $DECe) = split (",", $coords[1]);
    105106
    106 # Run addstar -resort to ensure the db is indexed 
     107# Run addstar -resort to ensure the db is indexed
    107108# XXX addstar should be able to recognize and skip indexed tables
    108109{
    109     my $command = "$addstar -resort"; 
     110    my $command = "$addstar -resort";
    110111    $command .= " -D CATDIR $dvodb";
    111112    $command .= " -region $RAs $RAe $DECs $DECe";
    112113
    113114    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    114         run(command => $command, verbose => $verbose);
    115 
    116     unless ($success) { 
    117         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    118         &my_die ("Unable to perform addstar -resort for dvodb $dvodb on region $region: $error_code", $corr_id, $error_code);
     115        run(command => $command, verbose => $verbose);
     116
     117    unless ($success) {
     118        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     119        &my_die ("Unable to perform addstar -resort for dvodb $dvodb on region $region: $error_code", $corr_id, $error_code);
    119120    }
    120121}
    … …  
    135136
    136137    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    137         run(command => $command, verbose => $verbose);
    138 
    139     unless ($success) { 
    140         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    141         &my_die ("Unable to perform relphot -grid for dvodb $dvodb on region $region: $error_code", $corr_id, $error_code);
     138        run(command => $command, verbose => $verbose);
     139
     140    unless ($success) {
     141        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     142        &my_die ("Unable to perform relphot -grid for dvodb $dvodb on region $region: $error_code", $corr_id, $error_code);
    142143    }
    143144}
    … …  
    176177
    177178# Push the results into the database
    178 { 
     179{
    179180    my $command = "$flatcorr -addprocess";
    180181    $command .= " -corr_id $corr_id";
    … …  
    184185    unless ($no_update) {
    185186
    186         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    187             run(command => $command, verbose => $verbose);
    188         unless ($success) {
    189             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    190             warn ("Unable to perform regtool -addprocessedimfile: $error_code");
    191             exit($error_code);
    192         }
     187        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     188            run(command => $command, verbose => $verbose);
     189        unless ($success) {
     190            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     191            warn ("Unable to perform regtool -addprocessedimfile: $error_code");
     192            exit($error_code);
     193        }
    193194    } else {
    194         print "skipping command: $command\n";
     195        print "skipping command: $command\n";
    195196    }
    196197}
    … …  
    218219        &my_die("Unable to parse metadata list", $corr_id, $PS_EXIT_PROG_ERROR);
    219220
    220     # check for existence 
     221    # check for existence
    221222    my $file = $$files[0];
    222223    my $chip_id = $file->{chip_id};
    … …  
    228229# flatcorr -inputimfile -chip_id $chip_id
    229230sub get_imfiles {
    230     my $chip_id = shift; 
     231    my $chip_id = shift;
    231232
    232233    my $command = "$flatcorr -inputimfile";
    … …  
    273274
    274275    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    275         run(command => $command, verbose => $verbose);
    276 
    277     unless ($success) { 
    278         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    279         &my_die ("Unable to register new detrend: $error_code", $corr_id, $PS_EXIT_PROG_ERROR);
     276        run(command => $command, verbose => $verbose);
     277
     278    unless ($success) {
     279        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     280        &my_die ("Unable to register new detrend: $error_code", $corr_id, $PS_EXIT_PROG_ERROR);
    280281    }
    281282
    … …  
    298299
    299300    foreach my $file (@$files) {
    300         # create the detrend correction for the imfiles based on the input imfiles
    301         my $reffile = $file->{uri};
    302         my $class_id = $file->{class_id};
    303 
    304         my $uri = $ipprc->filename("DVOCORR.OUTPUT", $outcorr, $class_id);
    305         unless ($uri) {
    306             &my_die ("Unable to find DVOCORR.OUTPUT in filerules", $corr_id, $PS_EXIT_PROG_ERROR);
    307         }
    308 
    309         my $command = "$dvoMakeCorr $outcorr";
    310         $command .= " -file $outgrid.fits";
    311         $command .= " -ref $reffile";
    312 
    313         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    314             run(command => $command, verbose => $verbose);
    315 
    316         unless ($success) {
    317             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    318             &my_die ("Unable to perform dvoMakeCorr: $error_code", $corr_id, $PS_EXIT_PROG_ERROR);
    319         }
    320 
    321         # register the detrend correction imfile
    322         $command = "$dettool -register_detrend_imfile";
    323         $command .= " -det_id $det_id";
    324         $command .= " -class_id $class_id";
    325         $command .= " -uri $uri";
    326         $command .= " -dbname $dbname" if defined $dbname;
    327 
    328         ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    329             run(command => $command, verbose => $verbose);
    330 
    331         unless ($success) {
    332             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    333             &my_die ("Unable to register new detrend: $error_code", $corr_id, $PS_EXIT_PROG_ERROR);
    334         }
     301        # create the detrend correction for the imfiles based on the input imfiles
     302        my $reffile = $file->{uri};
     303        my $class_id = $file->{class_id};
     304
     305        my $uri = $ipprc->filename("DVOCORR.OUTPUT", $outcorr, $class_id);
     306        unless ($uri) {
     307            &my_die ("Unable to find DVOCORR.OUTPUT in filerules", $corr_id, $PS_EXIT_PROG_ERROR);
     308        }
     309
     310        my $command = "$dvoMakeCorr $outcorr";
     311        $command .= " -file $outgrid.fits";
     312        $command .= " -ref $reffile";
     313
     314        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     315            run(command => $command, verbose => $verbose);
     316
     317        unless ($success) {
     318            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     319            &my_die ("Unable to perform dvoMakeCorr: $error_code", $corr_id, $PS_EXIT_PROG_ERROR);
     320        }
     321
     322        # register the detrend correction imfile
     323        $command = "$dettool -register_detrend_imfile";
     324        $command .= " -det_id $det_id";
     325        $command .= " -class_id $class_id";
     326        $command .= " -uri $uri";
     327        $command .= " -dbname $dbname" if defined $dbname;
     328
     329        ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     330            run(command => $command, verbose => $verbose);
     331
     332        unless ($success) {
     333            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     334            &my_die ("Unable to register new detrend: $error_code", $corr_id, $PS_EXIT_PROG_ERROR);
     335        }
    335336    }
    336337}
    … …  
    345346    if (not $no_update) {
    346347        my $command = "$flatcorr -addprocess";
    347         $command .= " -corr_id $corr_id";
     348        $command .= " -corr_id $corr_id";
    348349        $command .= " -fault $exit_code";
    349350        $command .= " -hostname $host" if defined $host;

  • branches/pap/ippScripts/scripts/ipp_cleanup.pl

    r27638 r28003  
    1414use File::Spec;
    1515use PS::IPP::Config 1.01 qw( :standard );
    16 use PS::IPP::Metadata::List qw( parse_md_list );
    1716use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
    1817use Pod::Usage qw( pod2usage );
    … …  
    108107    }
    109108
    110     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     109    # extract the metadata for the files into a hash list
     110    $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or
    111111        &my_die("Unable to parse metadata config doc", "chip", $stage_id, $PS_EXIT_PROG_ERROR);
    112 
    113     # extract the metadata for the files into a hash list
    114     $imfiles = parse_md_list($metadata) or
    115         &my_die("Unable to parse metadata list", "chip", $stage_id, $PS_EXIT_PROG_ERROR);
    116112
    117113    # loop over all of the imfiles, determine the path_base and class_id for each
    … …  
    196192            # Tell magicdstool that we've cleaned up this data, so it needs to do the same if it needs to do the same.
    197193            my $magicdstool = can_run('magicdstool') or die "Can't find magicdstool";
    198             $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -state full";
     194            $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -set_label goto_cleaned";
    199195            $command .= " -dbname $dbname" if defined $dbname;
    200196            ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    … …  
    249245        &my_die("Unable to perform camtool: $error_code", "camera", $stage_id, $error_code);
    250246    }
    251     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     247    $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    252248        &my_die("Unable to parse metadata config doc", "camera", $stage_id, $PS_EXIT_PROG_ERROR);
    253 
    254     $exps = parse_md_list($metadata) or
    255         &my_die("Unable to parse metadata list", "camera", $stage_id, $PS_EXIT_PROG_ERROR);
    256249
    257250    my $n_exps = @$exps;
    … …  
    316309        # Tell magicdstool that we've cleaned up this data, so it needs to do the same if it needs to do the same.
    317310        my $magicdstool = can_run('magicdstool') or die "Can't find magicdstool";
    318         $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -state full";
     311        $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -set_label goto_cleaned";
    319312        $command .= " -dbname $dbname" if defined $dbname;
    320313        ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    … …  
    375368        exit(0);
    376369    }
    377     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     370    $skyfiles = $mdcParser->parse_list(join "", @$stdout_buf) or
    378371        &my_die("Unable to parse metadata config doc", "warp", $stage_id, $PS_EXIT_PROG_ERROR);
    379 
    380     $skyfiles = parse_md_list($metadata) or
    381         &my_die("Unable to parse metadata list", "warp", $stage_id, $PS_EXIT_PROG_ERROR);
    382372
    383373    my @files = ();
    … …  
    457447            # Tell magicdstool that we've cleaned up this data, so it needs to do the same if it needs to do the same.
    458448            my $magicdstool = can_run('magicdstool') or die "Can't find magicdstool";
    459             $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -state full";
     449            $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -set_label goto_cleaned";
    460450            $command .= " -dbname $dbname" if defined $dbname;
    461451            ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    … …  
    515505    }
    516506
    517     my $metadata = $mdcParser->parse(join "", @{ $stdout_buf }) or
     507    $skyfiles = $mdcParser->parse_list(join "", @{ $stdout_buf }) or
    518508        &my_die("Unable to parse metadata config doc", "stack", $stage_id, $PS_EXIT_PROG_ERROR);
    519 
    520     $skyfiles = parse_md_list($metadata) or
    521         &my_die("Unable to parse metadata list", "stack", $stage_id, $PS_EXIT_PROG_ERROR);
    522509
    523510    my @files = ();
    … …  
    594581            # Tell magicdstool that we've cleaned up this data, so it needs to do the same if it needs to do the same.
    595582            my $magicdstool = can_run('magicdstool') or die "Can't find magicdstool";
    596             $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -state full";
     583            $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -set_label goto_cleaned";
    597584            $command .= " -dbname $dbname" if defined $dbname;
    598585            ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    … …  
    652639    }
    653640
    654     my $metadata = $mdcParser->parse(join "", @{ $stdout_buf }) or
     641    $skyfiles = $mdcParser->parse_list(join "", @{ $stdout_buf }) or
    655642        &my_die("Unable to parse metadata config doc", "diff", $stage_id, $PS_EXIT_PROG_ERROR);
    656 
    657     $skyfiles = parse_md_list($metadata) or
    658         &my_die("Unable to parse metadata list", "diff", $stage_id, $PS_EXIT_PROG_ERROR);
    659643
    660644    my @files = ();
    … …  
    747731            # Tell magicdstool that we've cleaned up this data, so it needs to do the same if it needs to do the same.
    748732            my $magicdstool = can_run('magicdstool') or die "Can't find magicdstool";
    749             $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -state full";
     733            $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -set_label goto_cleaned";
    750734            $command .= " -dbname $dbname" if defined $dbname;
    751735            ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    … …  
    806790    }
    807791
    808     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     792    # extract the metadata for the files into a hash list
     793    $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or
    809794        &my_die("Unable to parse metadata config doc", "fake", $stage_id, $PS_EXIT_PROG_ERROR);
    810 
    811     # extract the metadata for the files into a hash list
    812     $imfiles = parse_md_list($metadata) or
    813         &my_die("Unable to parse metadata list", "fake", $stage_id, $PS_EXIT_PROG_ERROR);
    814795
    815796    # loop over all of the imfiles, determine the path_base and class_id for each
    … …  
    927908
    928909
    929         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     910        # extract the metadata for the files into a hash list
     911        $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or
    930912        &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    931 
    932         # extract the metadata for the files into a hash list
    933         $imfiles = parse_md_list($metadata) or
    934             &my_die("Unable to parse metadata list", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    935913    }
    936914    # loop over all of the imfiles, determine the path_base and class_id for each
    … …  
    1013991    }
    1014992    if (@$stdout_buf != 0) {
    1015         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     993        my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    1016994            &my_die("Unable to parse metadata config doc", "$stage (detProcessedExp)", $stage_id, $PS_EXIT_PROG_ERROR);
    1017         my $exps = parse_md_list($metadata) or
    1018             &my_die("Unable to parse metadata list", "$stage (detProcessedExp)", $stage_id, $PS_EXIT_PROG_ERROR);
    1019995
    1020996        foreach my $exp (@$exps) {
    … …  
    10681044    # if there are no detResidImfiles (@$stdout_buf == 0), then silently exit.
    10691045    if (@$stdout_buf != 0) {
    1070         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1046        # extract the metadata for the files into a hash list
     1047        $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or
    10711048            &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    1072 
    1073         # extract the metadata for the files into a hash list
    1074         $imfiles = parse_md_list($metadata) or
    1075             &my_die("Unable to parse metadata list", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    10761049    }
    10771050    # loop over all of the imfiles, determine the path_base and class_id for each
    … …  
    11561129    }
    11571130    if (@$stdout_buf != 0) {
    1158         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1131        my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    11591132            &my_die("Unable to parse metadata config doc", "$stage (detResidExp)", $stage_id, $PS_EXIT_PROG_ERROR);
    1160         my $exps = parse_md_list($metadata) or
    1161             &my_die("Unable to parse metadata list", "$stage (detResidExp)", $stage_id, $PS_EXIT_PROG_ERROR);
    11621133
    11631134        foreach my $exp (@$exps) {
    … …  
    12021173        &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code);
    12031174    }
    1204     my $metadata = $mdcParser->parse(join "", @{ $stdout_buf }) or
     1175    $stacks = $mdcParser->parse_list(join "", @{ $stdout_buf }) or
    12051176        &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    1206 
    1207     $stacks = parse_md_list($metadata) or
    1208         &my_die("Unable to parse metadata list", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    12091177
    12101178    my @files = ();
    … …  
    12861254    }
    12871255    if (@$stdout_buf != 0) {
    1288         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1256        my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    12891257            &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    1290         my $exps = parse_md_list($metadata) or
    1291             &my_die("Unable to parse metadata list", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    12921258
    12931259        foreach my $exp (@$exps) {
    … …  
    13271293        &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code);
    13281294    }
    1329     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1295    my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    13301296        &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    1331 
    1332     my $exps = parse_md_list($metadata) or
    1333         &my_die("Unable to parse metadata list", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    13341297
    13351298    foreach my $exp (@$exps) {
    … …  
    13801343    }
    13811344    if (@$stdout_buf != 0) {
    1382         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1345        $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    13831346            &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    1384         $exps = parse_md_list($metadata) or
    1385             &my_die("Unable to parse metadata list", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    13861347
    13871348        foreach my $exp (@$exps) {
    … …  
    14251386        &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code);
    14261387    }
    1427     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1388    $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    14281389        &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    1429 
    1430     $exps = parse_md_list($metadata) or
    1431         &my_die("Unable to parse metadata list", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    14321390
    14331391    foreach my $exp (@$exps) {
    … …  
    15111469    }
    15121470    if (@$stdout_buf != 0) {
    1513         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1471        $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    15141472            &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    1515         $exps = parse_md_list($metadata) or
    1516             &my_die("Unable to parse metadata list", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    15171473
    15181474        foreach my $exp (@$exps) {
    … …  
    15591515        exit 0;
    15601516    }
    1561     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1517    $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    15621518        &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    1563 
    1564     $exps = parse_md_list($metadata) or
    1565         &my_die("Unable to parse metadata list", "$stage", $stage_id, $PS_EXIT_PROG_ERROR);
    15661519
    15671520    foreach my $exp (@$exps) {
    … …  
    16431596    }
    16441597    if (@$stdout_buf != 0) {
    1645         $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     1598        $exps = $mdcParser->parse_list(join "", @$stdout_buf) or
    16461599            &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    1647         $exps = parse_md_list($metadata) or
    1648             &my_die("Unable to parse metadata list", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR);
    16491600
    16501601        foreach my $exp (@$exps) {

  • branches/pap/ippScripts/scripts/ipp_detrend_combine.pl

    r17671 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
     9my $date = `date`;
    910print "\n\n";
    10 print "Starting script $0 on $host\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1112
    1213use vars qw( $VERSION );
    … …  
    3233    $workdir, $dbname, $no_update);
    3334GetOptions(
    34            'det_type=s'    => \$det_type, # Detrend type for new detrend
    35            'filelevel=s'   => \$filelevel, # File level for new detrend
    36            'inst=s'        => \$inst, # Instrument for new detrend
    37            'telescope=s'   => \$telescope, # Telescope for new detrend
    38            'filter=s'      => \$filter, # Filter name for new detrend
    39            'det_id1=s'     => \$det_id1, # Detrend id for detrend 1
    40            'iteration1=s'  => \$iter1, # Iteration for detrend 1
    41            'det_id2=s'     => \$det_id2, # Detrend id for detrend 2
    42            'iteration2=s'  => \$iter2, # Iteration for detrend 2
    43            'operation=s'   => \$operation, # Operation to perform on files
    44            'mask'          => \$mask, # Operation is on a mask
    45            'workdir=s'     => \$workdir, # Working directory for output files
    46            'dbname=s'      => \$dbname, # Database name
    47            'no-update'     => \$no_update, # Don't update the database
    48            ) or pod2usage( 2 );
     35           'det_type=s'    => \$det_type, # Detrend type for new detrend
     36           'filelevel=s'   => \$filelevel, # File level for new detrend
     37           'inst=s'        => \$inst, # Instrument for new detrend
     38           'telescope=s'   => \$telescope, # Telescope for new detrend
     39           'filter=s'      => \$filter, # Filter name for new detrend
     40           'det_id1=s'     => \$det_id1, # Detrend id for detrend 1
     41           'iteration1=s'  => \$iter1, # Iteration for detrend 1
     42           'det_id2=s'     => \$det_id2, # Detrend id for detrend 2
     43           'iteration2=s'  => \$iter2, # Iteration for detrend 2
     44           'operation=s'   => \$operation, # Operation to perform on files
     45           'mask'          => \$mask, # Operation is on a mask
     46           'workdir=s'     => \$workdir, # Working directory for output files
     47           'dbname=s'      => \$dbname, # Database name
     48           'no-update'     => \$no_update, # Don't update the database
     49           ) or pod2usage( 2 );
    4950
    5051pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
    5152pod2usage( -msg => "Required options --det_type --filelevel --inst --telescope --det_id1 --iteration1 --det_id2 --iteration2 --workdir",
    52            -exitval => 3,
    53            )
     53           -exitval => 3,
     54           )
    5455    unless defined $det_type
    5556    and defined $filelevel
    … …  
    6566$ipprc->define_camera($inst);
    6667
    67 my $STATS = 
    68    [   
     68my $STATS =
     69   [
    6970       #          PPSTATS KEYWORD         STATISTIC          CHIPTOOL FLAG
    7071       { name => "ROBUST_MEDIAN",  type => "mean",  flag => "-bg",             dtype => "float" },
    … …  
    9091die("File lists for detrends have differing lengths") unless scalar keys %$files1 == scalar keys %$files2;
    9192
    92 my ($det_id, $iter);          # Detrend identifier for the new detrend
     93my ($det_id, $iter);          # Detrend identifier for the new detrend
    9394unless ($no_update) {
    9495    my $command = "$dettool -register_detrend -det_type $det_type -filelevel $filelevel -workdir $workdir " .
    95         "-inst $inst -telescope $telescope"; # Command to run
     96        "-inst $inst -telescope $telescope"; # Command to run
    9697    $command .= " -filter $filter" if defined $filter;
    9798    $command .= " -dbname $dbname" if defined $dbname;
    9899    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    99         run(command => $command, verbose => 1);
     100        run(command => $command, verbose => 1);
    100101    unless ($success) {
    101         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    102         die("Unable to run dettool -register_detrend: $error_code");
     102        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     103        die("Unable to run dettool -register_detrend: $error_code");
    103104    }
    104105
    … …  
    137138    $command .= " -dbname $dbname" if defined $dbname;
    138139    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    139         run(command => $command, verbose => 1);
     140        run(command => $command, verbose => 1);
    140141    unless ($success) {
    141         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    142         die("Unable to run ppArith: $error_code");
     142        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     143        die("Unable to run ppArith: $error_code");
    143144    }
    144145
    … …  
    149150    my $stats = PS::IPP::Metadata::Stats->new($STATS); # Stats parser
    150151    {
    151         my $statsFile;          # File handle
    152         open $statsFile, $ipprc->file_resolve($outStats) or die("Can't open stats file $outStats: $!");
    153         my @contents = <$statsFile>; # Contents of file
    154         close $statsFile;
    155        
    156         my $metadata = $mdcParser->parse(join "", @contents) or die("Unable to parse metadata config doc");
    157 
    158         unless ($stats->parse($metadata)) {
    159             &my_die("Failure extracting metadata from the statistics output file.\n");
    160         }
     152        my $statsFile;          # File handle
     153        open $statsFile, $ipprc->file_resolve($outStats) or die("Can't open stats file $outStats: $!");
     154        my @contents = <$statsFile>; # Contents of file
     155        close $statsFile;
     156
     157        my $metadata = $mdcParser->parse(join "", @contents) or die("Unable to parse metadata config doc");
     158
     159        unless ($stats->parse($metadata)) {
     160            &my_die("Failure extracting metadata from the statistics output file.\n");
     161        }
    161162    }
    162163
    163164    # Register the imfile
    164165    unless ($no_update) {
    165         my $command = "$dettool -register_detrend_imfile -det_id $det_id "; # Command to run
    166         $command .= " -class_id $class_id -uri $outName -path_base $outRoot";
    167         $command .= $stats->cmdflags();
    168         $command .= " -dbname $dbname" if defined $dbname;
    169         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    170             run(command => $command, verbose => 1);
    171         unless ($success) {
    172             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    173             die("Unable to run dettool -register_detrend_imfile: $error_code");
    174         }
     166        my $command = "$dettool -register_detrend_imfile -det_id $det_id "; # Command to run
     167        $command .= " -class_id $class_id -uri $outName -path_base $outRoot";
     168        $command .= $stats->cmdflags();
     169        $command .= " -dbname $dbname" if defined $dbname;
     170        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     171            run(command => $command, verbose => 1);
     172        unless ($success) {
     173            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     174            die("Unable to run dettool -register_detrend_imfile: $error_code");
     175        }
    175176    }
    176177}
    … …  
    183184sub filelist
    184185{
    185     my $det_id = shift;         # Detrend identifier
    186     my $iter = shift;           # Iteration
     186    my $det_id = shift;         # Detrend identifier
     187    my $iter = shift;           # Iteration
    187188
    188189    my $command = "$detselect -select -det_id $det_id -iteration $iter"; # Command to run
    189190    $command .= " -dbname $dbname" if defined $dbname;
    190191    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    191         run(command => $command, verbose => 1);
     192        run(command => $command, verbose => 1);
    192193    unless ($success) {
    193         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    194         die("Unable to run detselect: $error_code");
     194        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     195        die("Unable to run detselect: $error_code");
    195196    }
    196197
    … …  
    202203
    203204    foreach my $item ( @$list ) {
    204         my $class_id = $item->{class_id};
    205         die("Multiple definitions of class_id=$class_id found for det_id=$det_id, iteration=$iter\n") if
    206             defined $files{$class_id};
    207         $files{$class_id} = parse_md_list($md);
     205        my $class_id = $item->{class_id};
     206        die("Multiple definitions of class_id=$class_id found for det_id=$det_id, iteration=$iter\n") if
     207            defined $files{$class_id};
     208        $files{$class_id} = parse_md_list($md);
    208209    }
    209210

  • branches/pap/ippScripts/scripts/lossy_compress_imfile.pl

    r27193 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    8687if ($state eq 'goto_compressed') {
    8788    # Find the actual filename for this run:
    88     &my_die("Couldn't find input file: $uri\n", $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR) 
    89         unless ($ipprc->file_exists($uri));
     89    &my_die("Couldn't find input file: $uri\n", $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR)
     90        unless ($ipprc->file_exists($uri));
    9091    my $uriReal = $ipprc->file_resolve( $uri );
    9192
    9293    # Create a compressed version:
    9394    my $compUri = $uri . ".fz";
    94     &my_die("Output compressed file already exists: $compUri\n", $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR) 
    95         if ($ipprc->file_exists($compUri));
     95    &my_die("Output compressed file already exists: $compUri\n", $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR)
     96        if ($ipprc->file_exists($compUri));
    9697    my $compReal= $ipprc->file_resolve( $compUri, 'create');
    9798    # Apparently we need to funpack before fpacking.  Probably should have realized that beforehand.
    9899    my $tempfile = new File::Temp ( TEMPLATE => "${exp_name}.XXXX",
    99                                     DIR => '/tmp/',
    100                                     UNLINK => !$save_temps,
    101                                     SUFFIX => '.fits');
     100                                    DIR => '/tmp/',
     101                                    UNLINK => !$save_temps,
     102                                    SUFFIX => '.fits');
    102103    my $tempReal = $tempfile->filename;
    103104
    104105    my $uncompress_command = "$funpack -S $uriReal > $tempReal";
    105106    my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
    106         run(command => $uncompress_command, verbose => $verbose);
     107        run(command => $uncompress_command, verbose => $verbose);
    107108    unless ($success) {
    108         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    109         &my_die("Unable to uncompress file: $uri -> $compUri: $error_code",
    110                 $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
     109        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     110        &my_die("Unable to uncompress file: $uri -> $compUri: $error_code",
     111                $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
    111112    }
    112113    my $compress_command = "$fpack -h -s 8 -S $tempReal >  $compReal";
    113114    print STDERR "$compReal $uriReal $compress_command\n";
    114115    ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
    115         run(command => $compress_command, verbose => $verbose);
     116        run(command => $compress_command, verbose => $verbose);
    116117    unless ($success) {
    117         $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    118         &my_die("Unable to compress file: $uri -> $compUri: $error_code",
    119                 $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
     118        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     119        &my_die("Unable to compress file: $uri -> $compUri: $error_code",
     120                $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
    120121    }
    121122    my $database_command = "$regtool -updateprocessedimfile -exp_id $exp_id -class_id $class_id -set_state compressed";
    … …  
    123124
    124125    &my_die("Expected output compressed file not found: $compUri\n", $exp_id,$exp_name,$class_id, $uri,$PS_EXIT_SYS_ERROR)
    125         unless ($ipprc->file_exists($compUri));
     126        unless ($ipprc->file_exists($compUri));
    126127
    127128    if ($no_update || $no_op) {
    128         print STDERR "NOUPDATE: $database_command\n";
     129        print STDERR "NOUPDATE: $database_command\n";
    129130    }
    130131    else {
    131         ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
    132             run(command => $database_command, verbose => $verbose);
    133         unless ($success) {
    134             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    135             &my_die("Unable to update database file: $uri -> $compUri: $error_code",
    136                     $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
    137         }
     132        ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
     133            run(command => $database_command, verbose => $verbose);
     134        unless ($success) {
     135            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     136            &my_die("Unable to update database file: $uri -> $compUri: $error_code",
     137                    $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
     138        }
    138139    }
    139140    exit(0);
    … …  
    149150    # Confirm we have both files
    150151    &my_die("Couldn't find original file: $uri\n", $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR)
    151         unless($ipprc->file_exists($uri));
     152        unless($ipprc->file_exists($uri));
    152153    my $uriReal = $ipprc->file_resolve( $uri );
    153    
     154
    154155    my $compUri = $uri . ".fz";
    155156    unless($ipprc->file_exists($compUri)) {
    156         &my_die("Couldn't find compressed version of the file: $compUri\n",
    157                 $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR);
    158 
    159         # If that die is removed, this will compress things as well.
    160         #
    161 #       &my_die("Output compressed file already exists: $compUri\n",
    162 #               $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR)
    163 #           if ($ipprc->file_exists($compUri));
    164 #       my $compReal= $ipprc->file_resolve( $compUri, 'create');
    165        
    166 #       my $compress_command = "$fpack -h -s 8 -S $uriReal >  $compReal";
    167 #       print STDERR "$compReal $uriReal $compress_command\n";
    168 #       my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
    169 #           run(command => $compress_command, verbose => $verbose);
    170 #       unless ($success) {
    171 #           $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    172 #           &my_die("Unable to compress file: $uri -> $compUri: $error_code",
    173 #                   $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
    174 #       }
     157        &my_die("Couldn't find compressed version of the file: $compUri\n",
     158                $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR);
     159
     160        # If that die is removed, this will compress things as well.
     161        #
     162#       &my_die("Output compressed file already exists: $compUri\n",
     163#               $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR)
     164#           if ($ipprc->file_exists($compUri));
     165#       my $compReal= $ipprc->file_resolve( $compUri, 'create');
     166
     167#       my $compress_command = "$fpack -h -s 8 -S $uriReal >  $compReal";
     168#       print STDERR "$compReal $uriReal $compress_command\n";
     169#       my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
     170#           run(command => $compress_command, verbose => $verbose);
     171#       unless ($success) {
     172#           $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     173#           &my_die("Unable to compress file: $uri -> $compUri: $error_code",
     174#                   $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
     175#       }
    175176    }
    176177
    … …  
    181182
    182183    unless ($no_op) {
    183         $neb->replicate($compUri);
    184         $neb->swap($uri,$compUri) or
    185             &my_die("Nebulous swap failed between $uri and $compUri",
    186                     $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR);
    187     }
    188     # Update database 
     184        $neb->replicate($compUri);
     185        $neb->swap($uri,$compUri) or
     186            &my_die("Nebulous swap failed between $uri and $compUri",
     187                    $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR);
     188    }
     189    # Update database
    189190
    190191    my $database_command = "$regtool -updateprocessedimfile -exp_id $exp_id -class_id $class_id -set_state lossy ";
    … …  
    192193
    193194    $database_command .= " -dbname $dbname" if defined $dbname;
    194    
     195
    195196    if ($no_update || $no_op) {
    196         print STDERR "NOUPDATE: $database_command\n";
     197        print STDERR "NOUPDATE: $database_command\n";
    197198    }
    198199    else {
    199         my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
    200             run(command => $database_command, verbose => $verbose);
    201         unless($success) {
    202             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    203             $neb->swap($uri,$compUri) or
    204                 &my_die("DB update failed and Nebulous swap-back failed between $uri and $compUri",
    205                         $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR);
    206             &my_die("Unable to update database file: $uri -> $compUri: $error_code",
    207                     $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
    208         }
    209         # remove original version
     200        my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) =
     201            run(command => $database_command, verbose => $verbose);
     202        unless($success) {
     203            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     204            $neb->swap($uri,$compUri) or
     205                &my_die("DB update failed and Nebulous swap-back failed between $uri and $compUri",
     206                        $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR);
     207            &my_die("Unable to update database file: $uri -> $compUri: $error_code",
     208                    $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR);
     209        }
     210        # remove original version
    210211    $neb->delete($compUri);
    211212    }

  • branches/pap/ippScripts/scripts/magic_destreak.pl

    r27396 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    4142# Parse the command-line arguments
    4243my ($magic_ds_id, $camera, $streaks, $inv_streaks, $exp_id, $stage, $stage_id, $component, $uri, $path_base, $cam_path_base, $cam_reduction);
    43 my ($outroot, $recoveryroot);
     44my ($outroot, $recoveryroot, $magicked);
    4445my ($replace, $release);
    4546my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile);
    … …  
    6162           'recoveryroot=s' => \$recoveryroot,# "directory" for saving the images of excised pixels
    6263           'replace=s'      => \$replace,    # replace the input images with the results.
     64           'magicked=s'     => \$magicked,   # magicked state of the run
    6365           'release'        => \$release,    # NAN masked pixels for release
    6466           'save-temps'     => \$save_temps, # Save temporary files?
    … …  
    7173
    7274pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
    73 pod2usage( -msg => "Required options: --magic_ds_id --camera --streaks --stage --stage_id --component --uri --path_base --outroot",
     75pod2usage( -msg => "Required options: --magic_ds_id --camera --streaks --stage --stage_id --component --uri --path_base --outroot --magicked",
    7476           -exitval => 3) unless
    7577    defined $magic_ds_id and
    … …  
    8284    defined $uri and
    8385    defined $path_base and
    84     defined $outroot;
     86    defined $outroot and
     87    defined $magicked;
    8588
    8689my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR ); # IPP configuration
    … …  
    209212                    &my_die("Unable to parse metadata list", $magic_ds_id, $component, $PS_EXIT_PROG_ERROR);
    210213
    211             $temp_dir = tempdir( CLEANUP => !$save_temps);
    212214            ($sfh, $skycell_list) = tempfile( "/tmp/skycell_list.XXXX", UNLINK => !$save_temps);
    213215
    … …  
    218220                } else {
    219221                    # diff run must have been cleaned up, need to create this skycell file on the fly
     222                    if (!defined $temp_dir ) {
     223                        $temp_dir = tempdir( CLEANUP => !$save_temps);
     224                    }
    220225                    my $skycell_id = $skycell->{skycell_id};
    221226                    $skycell_uri = "$temp_dir/$skycell_id";
    … …  
    247252            my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -";
    248253            my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    249                 run(command => $command, verbose => $verbose);
     254                    # note verbose == 0 to avoid polluting log files with almost always useless information
     255                run(command => $command, verbose => 0);
    250256            unless ($success) {
    251257                $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    … …  
    266272        $astrom = $ipprc->filename("PSASTRO.OUTPUT", $cam_path_base);
    267273
    268         if ($dynamicMasks) {
     274        # if magicked is non-zero we are updating a previously magicked component. In this case we don't
     275        # touch the camera mask
     276        if (!$magicked and $dynamicMasks) {
    269277            $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $cam_path_base, $class_id);
    270278            $ch_mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $path_base, $class_id);

  • branches/pap/ippScripts/scripts/magic_destreak_cleanup.pl

    r27604 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    6263$ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $magic_ds_id, $PS_EXIT_SYS_ERROR ) if $logfile;
    6364
    64 if (0) {
    65 my $nebulousServer = metadataLookupStr( $ipprc->{_siteConfig}, 'NEB_SERVER' );
    66 &my_die("cannot find NEB_SERVER in site configuration", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if !$nebulousServer;
    67 
    68 my $nebulous = eval { Nebulous::Client->new( proxy => $nebulousServer ); };
    69 if ($@ or not defined $nebulous) {
    70     &my_die ("Unable to create a Nebulous::Client object with proxy $nebulousServer", $magic_ds_id, $PS_EXIT_CONFIG_ERROR);
    71 }
    72 }
    7365
    7466$dbname = metadataLookupStr( $ipprc->{_siteConfig}, 'DBNAME' ) if !$dbname;
    … …  
    10799
    108100
     101&my_die("cleanup not supported for camera stage", $magic_ds_id, $PS_EXIT_PROG_ERROR) if $stage eq "camera";
     102
     103
    109104&my_die("unexpected run state found: $state", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if $state ne "goto_cleaned";
    110105&my_die("clean not allowed for raw stage, use goto_restore", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if $stage eq "raw";
    … …  
    129124$dbh->disconnect() or warn $dbh->errstr;
    130125
     126# We no longer clean up the camera stage mask files, but the code was left in place in case
     127# we change our minds.
     128my $cleanup_cam_mask = 0;
     129
    131130my $dynamicMasks;               # Use dynamic masks?
    132131foreach my $comp (@components) {
    … …  
    139138        if ($stage eq "chip") {
    140139            # Check to see if we're using dynamic masks
    141             if (!defined $dynamicMasks) {
     140            if ($cleanup_cam_mask && !defined $dynamicMasks) {
    142141                # Get the PSASTRO recipe
    143142                my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -";

  • branches/pap/ippScripts/scripts/magic_destreak_defineruns.pl

    r26030 r28003  
    1111use Sys::Hostname;
    1212my $host = hostname();
     13my $date = `date`;
    1314print "\n\n";
    14 print "Starting script $0 on $host\n\n";
     15print "Starting script $0 on $host at $date\n\n";
    1516
    1617use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/magic_destreak_revert.pl

    r27598 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    3738
    3839# Parse the command-line arguments
    39 my ($magic_ds_id, $camera, $streaks, $stage, $stage_id, $component, $uri, $path_base, $bothways, $cam_path_base, $cam_reduction);
     40my ($magic_ds_id, $camera, $streaks, $stage, $stage_id, $component, $uri, $path_base, $bothways, $cam_path_base, $cam_reduction, $magicked);
    4041my ($outroot, $recoveryroot, $replace, $release, $bytes, $md5sum);
    4142my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile);
    … …  
    5455           'replace=s'      => \$replace,    # replace the input images with the results.
    5556           'bothways=s'     => \$bothways,   # run has inverse files (bothways diff)
     57           'magicked=s'     => \$magicked,   # magicked state of the run
    5658           'save-temps'     => \$save_temps, # Save temporary files?
    5759           'dbname=s'       => \$dbname,     # Database name
    … …  
    6365
    6466pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
    65 pod2usage( -msg => "Required options: --magic_ds_id --camera --stage --stage_id --component --path_base --outroot",
     67pod2usage( -msg => "Required options: --magic_ds_id --camera --stage --stage_id --component --path_base --outroot --magicked",
    6668           -exitval => 3) unless
    6769    defined $magic_ds_id and
    … …  
    7173    defined $component and
    7274    defined $path_base and
     75    defined $magicked and
    7376    defined $outroot;
    7477
    … …  
    7679
    7780&my_die("cam_path_base is required for chip stage", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) if ($stage eq 'chip' and !$cam_path_base);
     81
     82
    7883
    7984my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR ); # IPP configuration
    … …  
    168173        my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -";
    169174        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    170             run(command => $command, verbose => $verbose);
     175            # note verbose == 0 to keep from polluting log file with lots of usually useless information
     176            run(command => $command, verbose => 0);
    171177        unless ($success) {
    172178            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    … …  
    181187    }
    182188
     189    $image  = $ipprc->filename("PPIMAGE.CHIP", $path_base, $class_id);
     190    $weight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $path_base, $class_id);
     191
    183192    # we use the mask output from the camera stage for input and replace
    184193    # the output of the chip stage with that mask as well.
    185     $image  = $ipprc->filename("PPIMAGE.CHIP", $path_base, $class_id);
    186     $weight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $path_base, $class_id);
    187 
    188     if ($dynamicMasks) {
     194    # Note that when destreaking as part of an update $magicked is non-zero.
     195    # In this case we do not touch the camera stage mask so there is no need to revert it
     196    if (!$magicked and $dynamicMasks) {
    189197        $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $cam_path_base, $class_id);
    190198        $ch_mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $path_base, $class_id);
    … …  
    194202
    195203    $bimage  = $ipprc->filename("PPIMAGE.CHIP", $backup_path_base, $class_id);
    196     # This is kludgey but correct
     204    # This is somewhat kludgey but it works whether the mask is camera mask or chip mask
    197205    $bmask   = dirname($backup_path_base) . "/SR_" . basename($mask);
    198206    $bch_mask= $ipprc->filename("PPIMAGE.CHIP.MASK", $backup_path_base, $class_id);

  • branches/pap/ippScripts/scripts/magic_process.pl

    r27634 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    9899    }
    99100
    100     my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
     101    $inputs = $mdcParser->parse_list(join "", @$stdout_buf) or
    101102        &my_die("Unable to parse metadata config doc", $magic_id, $node, $PS_EXIT_PROG_ERROR);
    102 
    103     $inputs = parse_md_list($metadata) or
    104         &my_die("Unable to parse metadata list", $magic_id, $node, $PS_EXIT_PROG_ERROR);
    105103}
    106104
    107105
    108106my @outputs;
     107my $inverse;                    # Using inverse diff?
    109108### Do the heavy lifting
    110109{
    … …  
    262261                cat_list_to_list($mfh, $in_path_base, "mask.list");
    263262                cat_list_to_list($wfh, $in_path_base, "weight.list");
     263
     264                if ($innode->{inverse}) {
     265                    $inverse = 1;
     266                }
    264267            }
    265268            close $in_fh;
    … …  
    329332    }
    330333}
     334
    331335if ($node eq "root") {
    332336    my $streaks_file = "$outroot.streaks";
    … …  
    347351    &run_verifystreaks($baseroot);
    348352
    349     my $command = "$magictool -addmask";
    350     $command   .= " -magic_id $magic_id";
    351     $command   .= " -uri $streaks_file";
    352     $command   .= " -streaks $num_streaks";
    353     $command   .= " -dbname $dbname" if defined $dbname;
    354 
    355     # Add the processed file to the database
    356     unless ($no_update) {
     353    my $exp_id;                 # Exposure identifier
     354    my $cam_path;               # Camera stage path_base
     355    {
     356        my $command = "magictool -exposure -magic_id $magic_id";
     357        $command .= " -inverse" if defined $inverse;
     358        $command .= " -dbname $dbname" if defined $dbname;
    357359        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    358360            run(command => $command, verbose => $verbose);
    359         unless ($success) {
    360             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    361             # This isn't going to work because our result was already entered.
    362             &my_die("Unable to perform magictool -addmask: $error_code", $magic_id, $node, $error_code);
    363         }
    364     } else {
    365         print "Skipping command: $command\n";
     361        my $exposures = $mdcParser->parse_list(join "", @$stdout_buf);
     362        my $exp = $$exposures[0]; # Exposure of interest (should only be one)
     363
     364        $exp_id = $exp->{exp_id};
     365        $cam_path = $exp->{path_base};
     366    }
     367
     368    {
     369        my $astrom = $ipprc->filename("PSASTRO.OUTPUT", $cam_path); # Astrometry file
     370        my $streaks = "$outroot.streaks";                           # Streaks file
     371        my $clusters = "$baseroot.verify/${exp_id}_clusterPos.txt"; # Clusters file
     372
     373        my $command = "ppCoord -astrom $astrom -streaks $streaks";
     374        if ($ipprc->file_exists($clusters)) {
     375            $command .= " -clusters $clusters";
     376        }
     377
     378        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     379            run(command => $command, verbose => $verbose);
     380        open my $coords, "> $outroot.coords";
     381        print $coords join("", @$stdout_buf);
     382        close $coords;
     383    }
     384
     385
     386    {
     387        my $command = "$magictool -addmask";
     388        $command   .= " -magic_id $magic_id";
     389        $command   .= " -uri $streaks_file";
     390        $command   .= " -streaks $num_streaks";
     391        $command   .= " -dbname $dbname" if defined $dbname;
     392
     393        # Add the processed file to the database
     394        unless ($no_update) {
     395            my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     396                run(command => $command, verbose => $verbose);
     397            unless ($success) {
     398                $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     399                # This isn't going to work because our result was already entered.
     400                &my_die("Unable to perform magictool -addmask: $error_code", $magic_id, $node, $error_code);
     401            }
     402        } else {
     403            print "Skipping command: $command\n";
     404        }
    366405    }
    367406}

  • branches/pap/ippScripts/scripts/magic_tree.pl

    r27596 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/make_burntool_pcontrol.pl

    r27033 r28003  
    1 #!/usr/bin/perl -w
     1#!/usr/bin/env perl
    22# script to generate a pcontrol.pro file to run burntool on a set of data.
    33
    44use DBI;
     5use warnings;
    56use DateTime;
    67use Getopt::Std;
     8use PS::IPP::Metadata::List qw( parse_md_list );
     9use PS::IPP::Config 1.01 qw( :standard );
     10use IPC::Cmd 0.36 qw( can_run run);
    711
    812use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock';
    … …  
    3539                   ) or die "Unable to connect to database $DBI::errstr\n";
    3640
     41my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1);
     42if ($missing_tools) {
     43    die "Cannot find required tools.";
     44}
    3745# Determine what the value of "BURNTOOL.STATE.GOOD" currently is:
    3846$burntoolStateGood = 999;
    39 open(LAZY,"ppConfigDump -camera GPC1 -dump-camera - |") || die "Can't run ppConfigDump\n";
     47open(LAZY,"$ppConfigDump -camera GPC1 -dump-camera - |") || die "Can't run ppConfigDump\n";
    4048while(<LAZY>) {
    4149    chomp;
    … …  
    4654}
    4755close(LAZY);
    48 #unless( $burntoolStateGood == 999) {
    49 #    print STDERR "GOOD == $burntoolStateGood\n";
    50 #}
    51 
    52 
    53 # List of which obs_modes are "science" and which are something else.
    54 %science = ('MD' => 1, '3PI' => 1, 'STS' => 1, 'CAL' => 1, 'M31' => 1, 'SS' => 1,
    55             'ENGINEERING' => 0, 'NULL' => 0, 'Unknown' => 1, ' ' => 0);
     56
     57# Read the nightly science config file and use that to determine which data is science
     58my $verbose = 0;
     59my $conf_cmd = "$ppConfigDump -dump-recipe NIGHTLY_SCIENCE -";
     60my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     61    run(command => $conf_cmd, verbose => $verbose);
     62unless ($success) {
     63    $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     64    &my_die("Unable to perform ppConfigDUmp: $error_code", $date, $PS_EXIT_SYS_ERROR);
     65}
     66
     67my @target_list;
     68my %object_list;
     69my $comment_list;
     70
     71my $mdcParser = PS::IPP::Metadata::Config->new;
     72my $metadata = $mdcParser->parse(join "", @$stdout_buf);
     73foreach my $entry (@{ $metadata }) {
     74    if (${ $entry }{name} eq 'TARGETS') {
     75        my @target_data = @{ ${ $entry }{value} };
     76        my $this_target = '';
     77       
     78        foreach my $tentry (@target_data) {
     79            if (${ $tentry }{name} eq 'NAME') {
     80                $this_target = ${ $tentry }{value};
     81                push @target_list, $this_target;
     82                $obsmode_list{$this_target} = '.*';
     83                $object_list{$this_target} = '.*';
     84                $comment_list{$this_target} = '.*';
     85            }
     86            elsif (${ $tentry }{name} eq 'OBSMODE') {
     87                $obsmode_list{$this_target} = ${ $tentry }{value};
     88                $obsmode_list{$this_target} =~ s/%//;
     89            }
     90            elsif (${ $tentry }{name} eq 'OBJECT') {
     91                $object_list{$this_target} = ${ $tentry }{value};
     92                $object_list{$this_target} =~ s/%//;
     93            }
     94            elsif (${ $tentry }{name} eq 'COMMENT') {
     95                $comment_list{$this_target} = ${ $tentry }{value};
     96                $comment_list{$this_target} =~ s/%//;
     97            }
     98        }
     99    }
     100}
    56101if (exists($opt{P})) {
    57     $science{Unknown} = 1;
     102    push @target_list, 'PR';
     103    $obsmode_list{'PR'} = 'Unknown';
     104    $object_list{'PR'} = '.*';
     105    $comment_list{'PR'} = '.*';
    58106}
    59107
    … …  
    119167   
    120168    # Find _ALL_ observations within the date range we care about
    121     $sth = "SELECT exp_id,dateobs,pon_time,exp_type,obs_mode,comment FROM rawExp WHERE " .
     169    $sth = "SELECT exp_id,dateobs,pon_time,exp_type,obs_mode,comment,object FROM rawExp WHERE " .
    122170        "dateobs >= '${date_min}' AND dateobs <= '${date_max}' order by dateobs";
    123171
    … …  
    133181    foreach $row_ref (@{ $data_ref }) {
    134182
    135         ($exp_id,$dateobs,$pontime,$exp_type,$obs_mode,$comment) = @{ $row_ref };
     183        ($exp_id,$dateobs,$pontime,$exp_type,$obs_mode,$comment,$object) = @{ $row_ref };
    136184        # Fix nulls in the database
    137185        if (!defined($obs_mode)) {
    138186            $obs_mode = ' ';
    139187        }
     188        if (!defined($object)) {
     189            $object = ' ';
     190        }
    140191        if (!defined($comment)) {
    141192            $comment = ' ';
    … …  
    144195        ($date,$time) = split / /, $dateobs;
    145196        ($year,$month,$day) = split /-/, $date;
    146         ($hour,$minute,$second) = split /:/, $time;
     197        ($hour,$minute,$second) = split /:/, $time; # / # This stops emacs run-on syntax highlights.
    147198       
    148199        $dt = DateTime->new( year   => $year, month  => $month, day    => $day,
    … …  
    155206        $et = $dt->epoch();
    156207
    157 
    158         if (!exists($science{$obs_mode})) {
    159             $science{$obs_mode} = 0;
    160         }
    161         if ((($science{$obs_mode} == 1)&&($comment !~ /Daytime/))||
    162             (($science{$obs_mode} == 0)&&(
    163                                           ($comment =~ /MD/)||($comment =~ /ThreePi/)||
    164                                           ($comment =~ /STS/i)||($comment =~ /M31/)||($comment =~ /Stellar Transit/)||
    165                                           ($comment =~ /CAL/i)||($comment =~ /SS/)||($comment =~ /SVS/)||
    166                                           ($comment =~ /Sweetspot/)||($comment =~ /virgo/i)||($comment =~ /kepler/)||
    167                                           ($comment =~ /sdss/))))                                         
    168         {
     208        if (is_science($exp_type,$obs_mode,$object,$comment)) {
    169209            if ($start_s[-1] == 0) {
    170210                $start_s[-1] = $et - 1800;
    … …  
    194234    # Scan again and count how many exposures are between windows
    195235    foreach $row_ref (@{ $data_ref }) {
    196         ($exp_id,$dateobs,$pontime,$exp_type,$obs_mode,$comment) = @{ $row_ref };
     236        ($exp_id,$dateobs,$pontime,$exp_type,$obs_mode,$comment,$object) = @{ $row_ref };
    197237        if (!defined($obs_mode)) {
    198238            $obs_mode = ' ';
    … …  
    204244        ($date,$time) = split / /, $dateobs;
    205245        ($year,$month,$day) = split /-/, $date;
    206         ($hour,$minute,$second) = split /:/, $time;
     246        ($hour,$minute,$second) = split /:/, $time; # / # another emacs syntax highlight bug.
    207247       
    208248        $dt = DateTime->new( year   => $year, month  => $month, day    => $day,
    … …  
    215255        $et = $dt->epoch();
    216256
    217         if (!exists($science{$obs_mode})) {
    218             die "No mode >>$obs_mode<<\n";
    219         }
    220        
    221257        for ($i = 0; $i <= $#start_s; $i++) {
    222             if (($et < $start_s[$i])&&($science{$obs_mode} == 0)) {
     258            if (($et < $start_s[$i])&&(is_science($exp_type,$obs_mode,$object,$comment) == 0)) {
    223259                if ($i == 0) {
    224260                    $skips[$i]++;
    … …  
    278314unless(exists($opt{b}) || ($N_ranges == 0)) {
    279315    print_epilogue();
     316}
     317
     318
     319# Subroutine to use the configuration file data and the exposure data to determine whether or not something is "science"
     320sub is_science {
     321#    if (is_science($exp_type,$obs_mode,$object,$comment)) {
     322    my ($exp_type,$obs_mode,$object,$comment) = @_;
     323    my $return_value = 0;
     324    unless($object) {
     325        $object = '';
     326    }
     327    if ($exp_type eq 'OBJECT') {
     328        foreach my $target (@target_list) {
     329#           print STDERR "$target $obsmode_list{$target} $exp_type $obs_mode $object $comment\n";
     330            if (($obs_mode =~ /$obsmode_list{$target}/)&&
     331                ($object   =~ /$object_list{$target}/)&&
     332                ($comment  =~ /$comment_list{$target}/)) {
     333                $return_value = 1;
     334            }
     335#           print ">$return_value $exp_type $obs_mode $object $comment $target $obsmode_list{$target} $object_list{$target} $comment_list{$target}\n";
     336            if ($return_value) {
     337                return($return_value);
     338            }
     339        }
     340    }
     341    return(0);
    280342}
    281343

  • branches/pap/ippScripts/scripts/publish_file.pl

    r27286 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
    9 print "Starting script $0 on $host\n\n";
     9my $date = `date`;
     10print "\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1012
    1113use DateTime;

  • branches/pap/ippScripts/scripts/rcserver_checkstatus.pl

    r25567 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/receive_advance.pl

    r24127 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
    9 print "Starting script $0 on $host\n\n";
     9my $date = `date`;
     10print "\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1012
    1113use DateTime;
    … …  
    5860    &my_die( "Unable to set up", $fileset_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration
    5961
    60 # update the fileset entry
    61 
    62 if ($dbinfo_uri and ($dbinfo_uri ne "NULL")) {
     62my $import_run_to_db = 0;
     63if ($import_run_to_db and $dbinfo_uri and ($dbinfo_uri ne "NULL")) {
    6364    my $filename = basename($dbinfo_uri);
    6465    my ($stage) = $filename =~ m|^dbinfo\.(\S+)\.\d+\.mdc$|; # Stage of interest
    … …  
    100101}
    101102
     103# update the fileset entry
    102104# All done
    103105{

  • branches/pap/ippScripts/scripts/receive_file.pl

    r25940 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
    9 print "Starting script $0 on $host\n\n";
     9my $date = `date`;
     10print "\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1012
    1113use DateTime;
    … …  
    124126    print "dirinfo resolved is: $resolved\n" if $verbose;
    125127
    126     open OUT, ">$resolved" 
     128    open OUT, ">$resolved"
    127129        or &my_die( "failed to open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
    128130    print OUT @$dirinfo_lines
    … …  
    130132    close OUT
    131133        or &my_die( "failed to close $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
    132    
     134
    133135    # update the fileset to allow processing of other files
    134136    my $command = "$receivetool -updatefileset -fileset_id $fileset_id";
    … …  
    160162    &my_die( "failed to resolve $dbinfo_uri\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$resolved;
    161163
    162     open OUT, ">$resolved" 
     164    open OUT, ">$resolved"
    163165        or &my_die( "failed to open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
    164166
    … …  
    227229                $current_component = $value;
    228230                $component_dir = $components->{$current_component};
    229                 &my_die( "$component_dir is null for $value in $filename: $runType\n", 
     231                &my_die( "$component_dir is null for $value in $filename: $runType\n",
    230232                        $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$component_dir;
    231233            } elsif ($name eq 'workdir') {
    … …  
    237239                $new_value = basename($value);
    238240            } elsif ((($name eq 'uri') or ($name eq 'path_base')) and ($value ne 'NULL')) {
    239                 &my_die( "$component_dir is null and we need it for $name", 
     241                &my_die( "$component_dir is null and we need it for $name",
    240242                        $file_id, $PS_EXIT_PROG_ERROR) if !$component_dir;
    241243

  • branches/pap/ippScripts/scripts/receive_fileset.pl

    r24786 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
    9 print "Starting script $0 on $host\n\n";
     9my $date = `date`;
     10print "\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1012
    1113use DateTime;

  • branches/pap/ippScripts/scripts/receive_setstatus.pl

    r24038 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    7475        $fileargs = " --list - --copy --abspath";
    7576    }
    76        
     77
    7778    # XXX need to create a fileset type for this
    7879    my $command = "echo $regline | dsreg --add $status_fs_name --product $status_product --type notset";

  • branches/pap/ippScripts/scripts/receive_source.pl

    r24744 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
    9 print "Starting script $0 on $host\n\n";
     9my $date = `date`;
     10print "\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1012
    1113use DateTime;

  • branches/pap/ippScripts/scripts/register_exp.pl

    r23688 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    126127$command .= " -end_stage $end_stage" if defined $end_stage;
    127128$command .= " -tess_id   $tess_id"   if defined $tess_id;
     129$command .= " -state full";
    128130$command .= " $cmdflags";
    129131

  • branches/pap/ippScripts/scripts/register_imfile.pl

    r26378 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );
    … …  
    115116    my $burntoolStateGood = 0;
    116117    foreach my $line (split /\n/, $out1) {
    117         if ($line =~ /FPA.BURNTOOL.APPLIED/) {
    118             $line =~ s/^\s+//;
    119             $burntoolState = (split /\s+/, $line)[2];
    120         }
    121         if ($line =~ /FPA.CAMERA/) {
    122             $line =~ s/^\s+//;
    123             if ((split /\s+/, $line)[2] eq 'GPC1') {
    124                 $isGPC1 = 1;
    125             }
    126         }
     118        if ($line =~ /FPA.BURNTOOL.APPLIED/) {
     119            $line =~ s/^\s+//;
     120            $burntoolState = (split /\s+/, $line)[2];
     121        }
     122        if ($line =~ /FPA.CAMERA/) {
     123            $line =~ s/^\s+//;
     124            if ((split /\s+/, $line)[2] eq 'GPC1') {
     125                $isGPC1 = 1;
     126            }
     127        }
    127128    }
    128129    if ($isGPC1 != 1) {
    129         $burntoolState = 0; # If it's not GPC1, you shouldn't have run burntool.
     130        $burntoolState = 0; # If it's not GPC1, you shouldn't have run burntool.
    130131    }
    131132    elsif (($isGPC1 == 1) && ($burntoolState == 1)) {
    132 #       print STDERR "In the good region: >>$burntoolState<<\n";
    133         my $ppConfigDump_cmd = "$ppConfigDump -camera GPC1 -dump-camera -";
    134         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    135             IPC::Cmd::run(command => $ppConfigDump_cmd, verbose => $verbose);
    136         unless ($success) {
    137             $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
    138             warn ("Unable to perform ppConfigDump");
    139             exit($error_code);
    140         }
    141 
    142         # This is ugly, but doing a full parse for one entry is a bit wasteful.
    143         foreach my $line (split /\n/, (join "", @$stdout_buf)) {
    144             if ($line =~ /BURNTOOL.STATE.GOOD/) {
    145                 $line =~ s/^\s+//;
    146                 $burntoolStateGood = (split /\s+/, $line)[2];
    147                 last;
    148             }
    149         }
    150         $burntoolState = $burntoolStateGood; # Positive because this has the header table.
    151        
     133#       print STDERR "In the good region: >>$burntoolState<<\n";
     134        my $ppConfigDump_cmd = "$ppConfigDump -camera GPC1 -dump-camera -";
     135        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     136            IPC::Cmd::run(command => $ppConfigDump_cmd, verbose => $verbose);
     137        unless ($success) {
     138            $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
     139            warn ("Unable to perform ppConfigDump");
     140            exit($error_code);
     141        }
     142
     143        # This is ugly, but doing a full parse for one entry is a bit wasteful.
     144        foreach my $line (split /\n/, (join "", @$stdout_buf)) {
     145            if ($line =~ /BURNTOOL.STATE.GOOD/) {
     146                $line =~ s/^\s+//;
     147                $burntoolStateGood = (split /\s+/, $line)[2];
     148                last;
     149            }
     150        }
     151        $burntoolState = $burntoolStateGood; # Positive because this has the header table.
     152
    152153    }
    153154    $cmdflags .= " -burntool_state $burntoolState ";
    … …  
    173174$command .= " -hostname $host" if defined $host;
    174175$command .= " -dbname $dbname" if defined $dbname;
     176$command .= " -data_state full";
    175177$command .= " $cmdflags";
    176178

  • branches/pap/ippScripts/scripts/stack_skycell.pl

    r27180 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use DateTime;

  • branches/pap/ippScripts/scripts/tdl_generate.pl

    r21202 r28003  
    1313use Sys::Hostname;
    1414my $host = hostname();
     15my $date = `date`;
    1516#print "\n\n";
    16 #print "Starting script $0 on $host\n\n";
     17#print "Starting script $0 on $host at $date\n\n";
    1718
    1819use vars qw( $VERSION );
    … …  
    5859# resolve any path:// or file:// in outroot
    5960$outroot = $ipprc->file_resolve($outroot);
    60    
     61
    6162# Look for programs we need
    6263my $missing_tools;

  • branches/pap/ippScripts/scripts/warp_overlap.pl

    r23688 r28003  
    88use Sys::Hostname;
    99my $host = hostname();
     10my $date = `date`;
    1011print "\n\n";
    11 print "Starting script $0 on $host\n\n";
     12print "Starting script $0 on $host at $date\n\n";
    1213
    1314use vars qw( $VERSION );

  • branches/pap/ippScripts/scripts/warp_skycell.pl

    r27180 r28003  
    77use Sys::Hostname;
    88my $host = hostname();
     9my $date = `date`;
    910print "\n\n";
    10 print "Starting script $0 on $host\n\n";
     11print "Starting script $0 on $host at $date\n\n";
    1112
    1213use DateTime;
    … …  
    299300            $command .= " -tess_id $tess_dir";
    300301            $command .= " -path_base $outroot"; # needed for logfile lookups
    301             $command .= " -magicked $magicked" if $magicked;
     302            $command .= " -set_magicked $magicked" if $magicked;
    302303
    303304            $command .= " -uri $outputImage" if !$quality;
    … …  
    321322            $command .= " -warp_id $warp_id";
    322323            $command .= " -skycell_id $skycell_id";
     324            $command .= " -set_magicked $magicked" if $magicked;
    323325            $command .= " -dbname $dbname"   if defined $dbname;
    324326
Note: See TracChangeset for help on using the changeset viewer.