Index: /branches/ccl_branches/ipponly-20191108/ippScripts/Build.PL =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/Build.PL (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/Build.PL (revision 41105) @@ -0,0 +1,161 @@ +use Module::Build; +# See perldoc Module::Build for details of how this works + +Module::Build->new( + module_name => 'ippscripts', + dist_version => '0.01', + author => 'Joshua Hoblitt ', + license => 'gpl', + create_makefile_pl => 'passthrough', + requires => { + 'Astro::FITS::CFITSIO' => 0, + 'Cache::File' => 0, + 'Carp' => 0, + 'Data::Dumper' => 0, + 'File::Basename' => 0, + 'File::Spec' => 0, + 'File::Temp' => 0, + 'Getopt::Long' => 0, + 'IPC::Cmd' => 0, + 'IPC::Run' => 0, + 'Math::Trig' => 0, + 'Pod::Usage' => 0, + 'PS::IPP::Config' => '1.01', + 'PS::IPP::Metadata::Config' => 0, + 'Statistics::Descriptive' => 0, + 'Storable' => 0, + 'Sys::Hostname' => 0, + }, + recommends => { + 'Test::Distribution' => '1.22', + }, + script_files => [qw( + scripts/ipp_datapath.pl + scripts/ipp_filename.pl + scripts/mdc2list.pl + scripts/register_imfile.pl + scripts/register_exp.pl + scripts/detrend_correct_imfile.pl + scripts/detrend_process_imfile.pl + scripts/detrend_process_exp.pl + scripts/detrend_stack.pl + scripts/detrend_norm_calc.pl + scripts/detrend_norm_apply.pl + scripts/detrend_norm_exp.pl + scripts/detrend_resid_imfile.pl + scripts/detrend_resid_exp.pl + scripts/detrend_reject_exp.pl + scripts/flatcorr_proc.pl + scripts/chip_imfile.pl + scripts/camera_exp.pl + scripts/addstar_multi_run.pl + scripts/addstar_run.pl + scripts/fake_imfile.pl + scripts/warp_overlap.pl + scripts/warp_skycell.pl + scripts/diff_skycell.pl + scripts/stack_skycell.pl + scripts/staticsky.pl + scripts/destreak_restore_camera.pl + scripts/magic_tree.pl + scripts/magic_process.pl + scripts/magic_cleanup.pl + scripts/magic_destreak.pl + scripts/magic_destreak_revert.pl + scripts/magic_destreak_cleanup.pl + scripts/magic_destreak_defineruns.pl + scripts/minidvodb_createdb.pl + scripts/minidvodb_merge.pl + scripts/minidvodb_premerge.pl + scripts/minidvodb_copy.pl + scripts/mergedvodb_copy.pl + scripts/mergedvodb_merge.pl + scripts/mergedvodb_queue.pl + scripts/ippdb.pl + scripts/ipp_cleanup.pl + scripts/ipp_inject_fileset.pl + scripts/ipp_inject_expname.pl + scripts/ipp_serial_inject.pl + scripts/ipp_serial_inject_into_nebulous.pl + scripts/ipp_serial_inject_split.pl + scripts/ipp_serial_inject_mosaic.pl + scripts/ipp_serial_register.pl + scripts/ipp_serial_detrend.pl + scripts/ipp_serial_chip.pl + scripts/ipp_serial_camera.pl + scripts/ipp_serial_warp.pl + scripts/ipp_serial_diff.pl + scripts/ipp_serial_stack.pl + scripts/ipp_serial_mops.pl + scripts/ipp_serial_mops_warps.pl + scripts/ipp_serial_magic.pl + scripts/ipp_mops_translate.pl + scripts/ipp_simulation_data.pl + scripts/isp_trans.pl + scripts/ds9_cmf_regions.pl + scripts/ipp_detrend_combine.pl + scripts/summit_copy.pl + scripts/ipp_image_path.pl + scripts/dist_cleanup.pl + scripts/dist_component.pl + scripts/dist_bundle.pl + scripts/dist_advancerun.pl + scripts/dist_fix_file.pl + scripts/dist_make_fileset.pl + scripts/dist_defineruns.pl + scripts/receive_source.pl + scripts/receive_fileset.pl + scripts/receive_file.pl + scripts/receive_advance.pl + scripts/receive_setstatus.pl + scripts/rcserver_checkstatus.pl + scripts/publish_file.pl + scripts/dqstats_bundle.pl + scripts/whichimage + scripts/automate_stacks.pl + scripts/nightly_science.pl + scripts/night_report.pl + scripts/lossy_compress_imfile.pl + scripts/rawcheck.pl + scripts/permcheck.pl + scripts/ipp_apply_burntool.pl + scripts/ipp_apply_burntool_single.pl + scripts/ipp_apply_burntool_fix.pl + scripts/make_burntool_pcontrol.pl + scripts/bundle_detrends.pl + scripts/ipp_cluster_load_monitor.pl + scripts/background_chip.pl + scripts/background_warp.pl + scripts/skycell_jpeg.pl + scripts/diffphot.pl + scripts/lap_science.pl + scripts/lap_queue_diff.pl + scripts/videophot_process.pl + scripts/listvideocells.pl + scripts/skycalibration.pl + scripts/regenerate_background.pl + scripts/relgroup_exp_list.pl + scripts/queuestaticsky.pl + scripts/psphot_fullforce_warp.pl + scripts/psphot_fullforce_summary.pl + scripts/stack_bkg_mk_mdc.pl + scripts/sc_mk_stack_mdc.pl + scripts/sc_mk_staticsky_mdc.pl + scripts/sc_check_diff.pl + scripts/sc_prepare_camera.pl + scripts/sc_prepare_chip.pl + scripts/sc_prepare_stack.pl + scripts/sc_prepare_staticsky.pl + scripts/sc_prepare_diff.pl + scripts/sc_prepare_ff.pl + scripts/sc_prepare_warp.pl + scripts/sc_prepare_run.pl + scripts/sc_remote_exec.pl + scripts/sc_remote_poll.pl + scripts/sc_retry_return.pl + scripts/sc_transfer_tool.pl + scripts/remote_md5sum.pl + )], + dist_abstract => 'Scripts for running the Pan-STARRS IPP', + dist_author => 'Paul Price ', +)->create_build_script; Index: /branches/ccl_branches/ipponly-20191108/ippScripts/Changes =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/Changes (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/Changes (revision 41105) @@ -0,0 +1,6 @@ +Revision history for Perl module ippScripts + +0.01 Thu Feb 23 13:55:57 2006 + - help scripts split out of the ippTools package + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/LICENSE =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/LICENSE (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/LICENSE (revision 41105) @@ -0,0 +1,260 @@ +The General Public License (GPL) +Version 2, June 1991 + +Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, +Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute +verbatim copies of this license document, but changing it is not allowed. + +Preamble + +The licenses for most software are designed to take away your freedom to share +and change it. By contrast, the GNU General Public License is intended to +guarantee your freedom to share and change free software--to make sure the +software is free for all its users. This General Public License applies to most of +the Free Software Foundation's software and to any other program whose +authors commit to using it. (Some other Free Software Foundation software is +covered by the GNU Library General Public License instead.) You can apply it to +your programs, too. + +When we speak of free software, we are referring to freedom, not price. Our +General Public Licenses are designed to make sure that you have the freedom +to distribute copies of free software (and charge for this service if you wish), that +you receive source code or can get it if you want it, that you can change the +software or use pieces of it in new free programs; and that you know you can do +these things. + +To protect your rights, we need to make restrictions that forbid anyone to deny +you these rights or to ask you to surrender the rights. These restrictions +translate to certain responsibilities for you if you distribute copies of the +software, or if you modify it. + +For example, if you distribute copies of such a program, whether gratis or for a +fee, you must give the recipients all the rights that you have. You must make +sure that they, too, receive or can get the source code. And you must show +them these terms so they know their rights. + +We protect your rights with two steps: (1) copyright the software, and (2) offer +you this license which gives you legal permission to copy, distribute and/or +modify the software. + +Also, for each author's protection and ours, we want to make certain that +everyone understands that there is no warranty for this free software. If the +software is modified by someone else and passed on, we want its recipients to +know that what they have is not the original, so that any problems introduced by +others will not reflect on the original authors' reputations. + +Finally, any free program is threatened constantly by software patents. We wish +to avoid the danger that redistributors of a free program will individually obtain +patent licenses, in effect making the program proprietary. To prevent this, we +have made it clear that any patent must be licensed for everyone's free use or +not licensed at all. + +The precise terms and conditions for copying, distribution and modification +follow. + +GNU GENERAL PUBLIC LICENSE +TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND +MODIFICATION + +0. This License applies to any program or other work which contains a notice +placed by the copyright holder saying it may be distributed under the terms of +this General Public License. The "Program", below, refers to any such program +or work, and a "work based on the Program" means either the Program or any +derivative work under copyright law: that is to say, a work containing the +Program or a portion of it, either verbatim or with modifications and/or translated +into another language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not covered by +this License; they are outside its scope. The act of running the Program is not +restricted, and the output from the Program is covered only if its contents +constitute a work based on the Program (independent of having been made by +running the Program). Whether that is true depends on what the Program does. + +1. You may copy and distribute verbatim copies of the Program's source code as +you receive it, in any medium, provided that you conspicuously and appropriately +publish on each copy an appropriate copyright notice and disclaimer of warranty; +keep intact all the notices that refer to this License and to the absence of any +warranty; and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and you may at +your option offer warranty protection in exchange for a fee. + +2. You may modify your copy or copies of the Program or any portion of it, thus +forming a work based on the Program, and copy and distribute such +modifications or work under the terms of Section 1 above, provided that you also +meet all of these conditions: + +a) You must cause the modified files to carry prominent notices stating that you +changed the files and the date of any change. + +b) You must cause any work that you distribute or publish, that in whole or in +part contains or is derived from the Program or any part thereof, to be licensed +as a whole at no charge to all third parties under the terms of this License. + +c) If the modified program normally reads commands interactively when run, you +must cause it, when started running for such interactive use in the most ordinary +way, to print or display an announcement including an appropriate copyright +notice and a notice that there is no warranty (or else, saying that you provide a +warranty) and that users may redistribute the program under these conditions, +and telling the user how to view a copy of this License. (Exception: if the +Program itself is interactive but does not normally print such an announcement, +your work based on the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If identifiable +sections of that work are not derived from the Program, and can be reasonably +considered independent and separate works in themselves, then this License, +and its terms, do not apply to those sections when you distribute them as +separate works. But when you distribute the same sections as part of a whole +which is a work based on the Program, the distribution of the whole must be on +the terms of this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest your rights to +work written entirely by you; rather, the intent is to exercise the right to control +the distribution of derivative or collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program with the +Program (or with a work based on the Program) on a volume of a storage or +distribution medium does not bring the other work under the scope of this +License. + +3. You may copy and distribute the Program (or a work based on it, under +Section 2) in object code or executable form under the terms of Sections 1 and 2 +above provided that you also do one of the following: + +a) Accompany it with the complete corresponding machine-readable source +code, which must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange; or, + +b) Accompany it with a written offer, valid for at least three years, to give any +third party, for a charge no more than your cost of physically performing source +distribution, a complete machine-readable copy of the corresponding source +code, to be distributed under the terms of Sections 1 and 2 above on a medium +customarily used for software interchange; or, + +c) Accompany it with the information you received as to the offer to distribute +corresponding source code. (This alternative is allowed only for noncommercial +distribution and only if you received the program in object code or executable +form with such an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for making +modifications to it. For an executable work, complete source code means all the +source code for all modules it contains, plus any associated interface definition +files, plus the scripts used to control compilation and installation of the +executable. However, as a special exception, the source code distributed need +not include anything that is normally distributed (in either source or binary form) +with the major components (compiler, kernel, and so on) of the operating system +on which the executable runs, unless that component itself accompanies the +executable. + +If distribution of executable or object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the source +code from the same place counts as distribution of the source code, even though +third parties are not compelled to copy the source along with the object code. + +4. You may not copy, modify, sublicense, or distribute the Program except as +expressly provided under this License. Any attempt otherwise to copy, modify, +sublicense or distribute the Program is void, and will automatically terminate +your rights under this License. However, parties who have received copies, or +rights, from you under this License will not have their licenses terminated so long +as such parties remain in full compliance. + +5. You are not required to accept this License, since you have not signed it. +However, nothing else grants you permission to modify or distribute the Program +or its derivative works. These actions are prohibited by law if you do not accept +this License. Therefore, by modifying or distributing the Program (or any work +based on the Program), you indicate your acceptance of this License to do so, +and all its terms and conditions for copying, distributing or modifying the +Program or works based on it. + +6. Each time you redistribute the Program (or any work based on the Program), +the recipient automatically receives a license from the original licensor to copy, +distribute or modify the Program subject to these terms and conditions. You +may not impose any further restrictions on the recipients' exercise of the rights +granted herein. You are not responsible for enforcing compliance by third parties +to this License. + +7. If, as a consequence of a court judgment or allegation of patent infringement +or for any other reason (not limited to patent issues), conditions are imposed on +you (whether by court order, agreement or otherwise) that contradict the +conditions of this License, they do not excuse you from the conditions of this +License. If you cannot distribute so as to satisfy simultaneously your obligations +under this License and any other pertinent obligations, then as a consequence +you may not distribute the Program at all. For example, if a patent license would +not permit royalty-free redistribution of the Program by all those who receive +copies directly or indirectly through you, then the only way you could satisfy +both it and this License would be to refrain entirely from distribution of the +Program. + +If any portion of this section is held invalid or unenforceable under any particular +circumstance, the balance of the section is intended to apply and the section as +a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any patents or other +property right claims or to contest validity of any such claims; this section has +the sole purpose of protecting the integrity of the free software distribution +system, which is implemented by public license practices. Many people have +made generous contributions to the wide range of software distributed through +that system in reliance on consistent application of that system; it is up to the +author/donor to decide if he or she is willing to distribute software through any +other system and a licensee cannot impose that choice. + +This section is intended to make thoroughly clear what is believed to be a +consequence of the rest of this License. + +8. If the distribution and/or use of the Program is restricted in certain countries +either by patents or by copyrighted interfaces, the original copyright holder who +places the Program under this License may add an explicit geographical +distribution limitation excluding those countries, so that distribution is permitted +only in or among countries not thus excluded. In such case, this License +incorporates the limitation as if written in the body of this License. + +9. The Free Software Foundation may publish revised and/or new versions of the +General Public License from time to time. Such new versions will be similar in +spirit to the present version, but may differ in detail to address new problems or +concerns. + +Each version is given a distinguishing version number. If the Program specifies a +version number of this License which applies to it and "any later version", you +have the option of following the terms and conditions either of that version or of +any later version published by the Free Software Foundation. If the Program does +not specify a version number of this License, you may choose any version ever +published by the Free Software Foundation. + +10. If you wish to incorporate parts of the Program into other free programs +whose distribution conditions are different, write to the author to ask for +permission. For software which is copyrighted by the Free Software Foundation, +write to the Free Software Foundation; we sometimes make exceptions for this. +Our decision will be guided by the two goals of preserving the free status of all +derivatives of our free software and of promoting the sharing and reuse of +software generally. + +NO WARRANTY + +11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS +NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE +COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM +"AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR +IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE +ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, +YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR +CORRECTION. + +12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED +TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY +WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS +PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM +(INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY +OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS +BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +END OF TERMS AND CONDITIONS Index: /branches/ccl_branches/ipponly-20191108/ippScripts/MANIFEST =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/MANIFEST (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/MANIFEST (revision 41105) @@ -0,0 +1,66 @@ +Build.PL +Changes +LICENSE +MANIFEST +README +scripts/ipp_datapath.pl +scripts/ipp_filename.pl +scripts/mdc2list.pl +scripts/register_imfile.pl +scripts/register_exp.pl +scripts/detrend_process_imfile.pl +scripts/detrend_process_exp.pl +scripts/detrend_stack.pl +scripts/detrend_norm_calc.pl +scripts/detrend_norm_apply.pl +scripts/detrend_norm_exp.pl +scripts/detrend_resid_exp.pl +scripts/detrend_resid_imfile.pl +scripts/detrend_reject_exp.pl +scripts/chip_imfile.pl +scripts/camera_exp.pl +scripts/warp_overlap.pl +scripts/warp_skycell.pl +scripts/diff_skycell.pl +scripts/stack_skycell.pl +scripts/ipp_serial_inject.pl +scripts/ipp_serial_inject_mosaic.pl +scripts/ipp_serial_register.pl +scripts/ipp_serial_detrend.pl +scripts/ipp_serial_chip.pl +scripts/ipp_serial_camera.pl +scripts/ipp_serial_warp.pl +scripts/ipp_serial_diff.pl +scripts/ipp_serial_stack.pl +scripts/ipp_simulation_data.pl +scripts/isp_trans.pl +scripts/ds9_cmf_regions.pl +scripts/automate_stacks.pl +scripts/nightly_science.pl +scripts/lossy_compress_imfile.pl +scripts/rawcheck.pl +scripts/permcheck.pl +scripts/ipp_apply_burntool.pl +scripts/ipp_apply_burntool_single.pl +scripts/ipp_apply_burntool_fix.pl +scripts/make_burntool_pcontrol.pl +scripts/bundle_detrends.pl +scripts/ipp_cluster_load_monitor.pl +scripts/skycell_jpeg.pl +scripts/lap_science.pl +scripts/lap_queue_diff.pl +scripts/regenerate_background.pl +scripts/sc_mk_stack_mdc.pl +scripts/sc_mk_staticsky_mdc.pl +scripts/sc_check_diff.pl +scripts/sc_prepare_camera.pl +scripts/sc_prepare_chip.pl +scripts/sc_prepare_stack.pl +scripts/sc_prepare_staticsky.pl +scripts/sc_prepare_diff.pl +scripts/sc_prepare_ff.pl +scripts/sc_prepare_warp.pl +scripts/sc_remote_exec.pl +scripts/sc_transfer_tool.pl +scripts/remote_md5sum.pl +t/00_distribution.t Index: /branches/ccl_branches/ipponly-20191108/ippScripts/README =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/README (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/README (revision 41105) @@ -0,0 +1,15 @@ +pod2text foo.pm > README + +If this is still here it means the programmer was too lazy to create the readme file. + +You can create it now by using the command shown above from this directory. + +At the very least you should be able to use this set of instructions +to install the module... + +perl Build.PL +./Build +./Build test +./Build install + +If you are on a windows box you should use 'nmake' rather than 'make'. Index: /branches/ccl_branches/ipponly-20191108/ippScripts/queue_chips_by_night.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/queue_chips_by_night.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/queue_chips_by_night.pl (revision 41105) @@ -0,0 +1,102 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $stdate = `date`; +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my @ARGS = @ARGV; + +my ( $date, $data_group_base, $label, $tess_id, $end_stage, $workdir_base, $dbname ); + +GetOptions( + 'date=s' => \$date, # date, like this 2011-02-12 + 'data_group_base=s' => \$data_group_base, # data_group_base, like this: isp + 'label=s' => \$label, # label + 'dbname|d=s' => \$dbname, # Database name + 'tess_id=s' => \$tess_id, # tess_id + 'end_stage=s' => \$end_stage, # end_stage + 'workdir_base=s' => \$workdir_base, # workdir + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dbname --label --tess_id --date \n Optional: --data_group_base, end_stage, workdir_base", + -exitval => 3) unless + defined $dbname and + defined $label and + defined $tess_id and + defined $date; + +my $truncdate = $date; + $truncdate =~ s/-//g; +if (defined $data_group_base) { + print "found data_group_base = $data_group_base\n"; +} else { + $data_group_base = $label; + print "using $label as data_group_base\n"; +} +if (defined $end_stage) { + print "found end_stage = $end_stage\n"; +} else { + $end_stage = "camera"; + print "using camera as end_stage\n"; +} +if (defined $workdir_base) { + print "found workdir_base = $workdir_base\n"; +} else { + $workdir_base = "neb://\@HOST\@.0/$dbname/$label"; + print "using $workdir_base as workdir\n"; +} + +# we have all the pieces, now build up the chiptool: + +my $command = "$chiptool -definebyquery -unique"; +$command .= " -dbname $dbname"; +$command .= " -dateobs_begin '$date"."T00:00:00'"; +$command .= " -dateobs_end '$date"."T23:59:59'"; +$command .= " -set_label $label"; +$command .= " -set_data_group $data_group_base.$truncdate"; +$command .= " -set_workdir $workdir_base/$truncdate"; +$command .= " -set_end_stage $end_stage"; +$command .= " -set_tess_id $tess_id"; + +print "\nrunning this command:\n\n$command\n\n"; + + +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform chiptool -definebyquery: $error_code\n"); + exit($error_code); + +} + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/addstar_multi_run.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/addstar_multi_run.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/addstar_multi_run.pl (revision 41105) @@ -0,0 +1,369 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $addtool = can_run('addtool') or (warn "Can't find addtool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} +my $minidvodb_path; + +my ( $label,$camera, $stage, $stage_id, $use_diff_inv, $outroot, $stageroot, $dbname, $reduction, $dvodb, $minidvodb, $minidvodb_name, $minidvodb_group, $image_only, $verbose, $no_update, + $no_op, $redirect, $save_temps, $limit_number); +GetOptions( + 'label=s' => \$label, # addstar label + 'stage=s' => \$stage, # stage (camera, fullforce, etc) + 'stage_id=s' => \$stage_id, + 'camera=s' => \$camera, # Camera + 'outroot=s' => \$outroot, # output file base name + 'dvodb=s' => \$dvodb, # output DVO database + 'stageroot=s' => \$stageroot, # stage root name. + 'limit=i' => \$limit_number, + 'use_diff_inv' => \$use_diff_inv, # use inv images for diff cmf? + 'dbname=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'minidvodb_name=s' => \$minidvodb_name, # miniDVO database name + 'minidvodb_group=s' => \$minidvodb_group, # miniDVO database group + 'minidvodb' => \$minidvodb, # use minidvodb? + 'image-only' => \$image_only, # Print to stdout + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --label --stage --stage_id --camera --outroot --dvodb --stageroot", + -exitval => 3, + ) unless + defined $stage and + defined $stage_id and + defined $label and + defined $outroot and + defined $stageroot and + defined $dvodb and + defined $camera; + +if ($minidvodb && !defined($minidvodb_group)) { + my_die( "missing minidvodb_group", $stage_id, $stage, $label, 3 ); + } +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $stage_id, $stage, $label, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot) or &my_die("Missing entry from camera config", $stage_id, $stage, $label, $PS_EXIT_CONFIG_ERROR); + +#my $logDest = "stuff.txt"; +if ($redirect) { + $ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $stage_id,$stage, $label, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; + +if ($stage =~/fullforce/) { + $reduction='DEFAULT'; + #hardwired because why not +} +if ($stage =~/diff/) { + $reduction='DEFAULT'; + #hardwired because why not +} + +my $recipe_addstar = $ipprc->reduction($reduction, 'ADDSTAR'); + +&my_die("Unrecognised ADDSTAR recipe", $stage_id, $stage, $label, $PS_EXIT_CONFIG_ERROR) unless defined $recipe_addstar; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +#my $temp_file = $outroot.".log.".$label.".".$stage.".".$stage_id.".list"; +my $temp_file = "/tmp/addstar.list"; +# XXX this temp_file is dangerous: multiple instances of this program will overwrite + +print "using $temp_file for list\n"; + +open( TEMPLIST, ">$temp_file") or &my_die( "Can't open $temp_file\n", $stage_id,$stage,$label, $PS_EXIT_UNKNOWN_ERROR); + +my @stage_extra1 = (); + +# query database for list of exposures: we need to generate the input list for addstar +{ + my $mdcParser = PS::IPP::Metadata::Config->new; + + my $command = "$addtool -pendingexp"; + $command .= " -stage_id $stage_id"; + $command .= " -stage $stage"; + $command .= " -label $label"; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " -limit $limit_number" if defined $limit_number; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get info on addRun", $stage_id,$stage, $label, $PS_EXIT_SYS_ERROR) unless $success; + + if (scalar @$stdout_buf == 0 ) { + # if there are no entries, just exit (do not update database with a fault) + # &my_die( "empty addRun", $stage_id,$stage,$label, $PS_EXIT_SYS_ERROR); + print "empty addRun, exiting... $stage, $stage_id, $label\n"; + exit 0; + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $stage_id,$stage,$label, $PS_EXIT_PROG_ERROR); + # this fails if there is nothing listed. I checked. + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $stage_id,$stage,$label, $PS_EXIT_PROG_ERROR); + my $num_components = scalar @$components; + print "there are $num_components\n"; + + # go through the list of components to create addstar input list + foreach my $comp (@$components) { + my $mparsed = $comp->{stageroot}; + + if (!defined($mparsed)) { + &my_die("Unable to parse stageroot", $stage_id,$stage,$label, $PS_EXIT_PROG_ERROR); + } #but just to make sure, have it grab a minidvodb_name, to make sure it's not junk. + print "found a value for stageroot:$mparsed\n"; + + my $fpaObjects = $mparsed . '.cmf'; + my $realFile = $ipprc->file_resolve($fpaObjects); + if (!defined($realFile)) { + &my_die("unable to resolve real file from $mparsed",$stage_id, $stage, $label, 7); + } + + printf TEMPLIST "$realFile = $fpaObjects\n"; + if ($stage =~ /diff/) { # hardwired for now: $use_diff_inv) { + print "finding the inv.cmf files\n"; + my $fpaObjectsInv = $mparsed . '.inv.cmf'; + my $realFileInv = $ipprc->file_resolve($fpaObjectsInv); + if (!defined($realFileInv)) { + &my_die("unable to resolve real file from $mparsed", $stage_id, $stage, $label, 8); + } + printf TEMPLIST "$realFileInv = $fpaObjectsInv\n"; + } + + # save the stage_extra1 values so we can update the database correctly at the end + my $stage_extra1_value = $comp->{stage_extra1}; + if (!defined($stage_extra1_value)) { + &my_die("unable to find stage_extra1 value for $mparsed", $stage_id, $stage, $label, 9); + } + push @stage_extra1, $stage_extra1_value; + } +} + +close(TEMPLIST); +print "saved $temp_file here\n"; + +# convert supplied DVO database name to UNIX filename +my $dvodbReal; +if (defined $dvodb) { + $dvodbReal = $ipprc->dvo_catdir( $dvodb ); # catdir for DVO + $dvodbReal = $ipprc->convert_filename_absolute( $dvodbReal ) or &my_die("can't get path for dvodb", $stage_id,$stage,$label, $PS_EXIT_CONFIG_ERROR); +} + +my $dtime_addstar = 0; +if (defined $dvodbReal) { + if ($minidvodb) { + my $command = "addtool -listminidvodbrun "; + $command .= " -minidvodb_group $minidvodb_group" if defined $minidvodb_group; + $command .= " -minidvodb_name $minidvodb_name" if defined $minidvodb_name; + $command .= " -state 'active' -limit 1"; + $command .= " -dbname $dbname" if defined $dbname; + print $command; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get active minidvodb_name", $stage_id,$stage,$label, $PS_EXIT_SYS_ERROR) unless $success; + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $stage_id,$stage,$label, $PS_EXIT_PROG_ERROR); + + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $stage_id,$stage,$label, $PS_EXIT_PROG_ERROR); + my $comp = $$components[0]; + $minidvodb_path = $comp->{minidvodb_path}; + $minidvodb_name = $comp->{minidvodb_name}; + + if (!defined($minidvodb_path)) { + &my_die("Unable to parse minidvodb_path", $stage_id,$stage,$label, $PS_EXIT_PROG_ERROR); + } + if (!defined($minidvodb_name)) { + &my_die("Unable to parse minidvodb_name", $stage_id,$stage,$label, $PS_EXIT_PROG_ERROR); + } + } else { + $minidvodb_path = $dvodbReal; + } + + unless ($no_op) { + print $dvodbReal; + + ## addstar can either save the full set of detections, or just + ## the image metadata, in the dvodb. this is set in the + ## database table addRun + + # addstar requires the user to have a valid .ptolemyrc which + # in turn points at ippconfig/dvo.site + + # get the names for the camera and the real input file + my $camdir = $ipprc->dvo_cameradir(); # Camera directory for addstar + + # most cameras use CHIP_HEADER. other exceptions: + # gpc1 @ camera : PHU_HEADER + # gpc1 @ staticsky : NOMINAL (is uncalibrated) + + # temporary hard-wired info + my $zeroPointOption = "CHIP_HEADER"; + if (($camdir =~ /gpc1/) && ($stage =~ /staticsky/)) { + $zeroPointOption = "NOMINAL"; + } + if (($camdir =~ /gpc1/) && ($stage =~ /cam/)) { + $zeroPointOption = "PHU_HEADER"; + } + + # require a defined output dvo database to run addstar (ie, refuse to use the .ptolemyrc default) + my $command = "$addstar -update"; # XXX optionally set -update? + $command .= " -D CAMERA $camdir"; + $command .= " -D CATDIR $minidvodb_path"; + $command .= " -D ZERO_POINT_OPTION $zeroPointOption"; + $command .= " -list $temp_file"; + $command .= " -image" if $image_only; + if ($stage =~ /staticsky/) { + $command .= " -accept-astrom -quick-airmass"; + } #careful here - this matches staticsky and staticsky_multi + if ($stage =~ /skycal/) { + $command .= " -quick-airmass"; + } #careful here - this matches staticsky and staticsky_multi + if ($stage =~ /diff/) { + $command .= " -accept-astrom"; + if ($use_diff_inv) { + $command .= " -diff-inv"; + } + } + + if ($stage =~ /fullforce/) { + $command .= " -accept-astrom -xrad"; + } + + my $mjd_addstar_start = DateTime->now->mjd; # MJD of starting script + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform addstar: $error_code", $stage_id,$stage,$label, $error_code); + } + $dtime_addstar = 86400.0*(DateTime->now->mjd - $mjd_addstar_start); # MJD of starting script + } +} + +my $stage_extra1_list = ""; +my $Nstage_extra1_list = @stage_extra1; + +for (my $i = 0; $i < $Nstage_extra1_list; $i ++) { + $stage_extra1_list .= "$stage_extra1[$i]"; + if ($i < $Nstage_extra1_list - 1) { + $stage_extra1_list .= ","; + } + print "STAGE EXTRA1 : $stage_extra1[$i]\n"; +} + +# at the end, we need to update the database with the entries we actually processed +# these are identified by stage_extra1, listed in the array @stage_extra1 +my $fpaCommand = "$addtool -addprocessedexp"; +$fpaCommand .= " -multiadd"; +$fpaCommand .= " -stage $stage"; +$fpaCommand .= " -stage_id $stage_id"; +$fpaCommand .= " -multiaddlabel $label"; +$fpaCommand .= " -dtime_addstar $dtime_addstar"; +if ($Nstage_extra1_list > 0) { + $fpaCommand .= " -stage_extra1_list $stage_extra1_list"; +} +$fpaCommand .= " -path_base $outroot"; +$fpaCommand .= " -dvodb_path $minidvodb_path" if defined $minidvodb_path; +$fpaCommand .= " -minidvodb_name $minidvodb_name" if defined $minidvodb_name; +$fpaCommand .= " -dbname $dbname" if defined $dbname; + +print $fpaCommand; + +# Add the result into the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $fpaCommand, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to add result to database: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $fpaCommand\n"; +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $stage_id = shift; # Camtool identifier + my $stage = shift; + my $label = shift; + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $stage_id and not $no_update) { + my $command = "$addtool -multiadd -stage_id $stage_id"; + $command .= " -addprocessedexp"; + $command .= " -fault $exit_code"; + $command .= " -stage $stage"; + $command .= " -multiaddlabel $label"; + $command .= " -dvodb_path $minidvodb_path" if defined $minidvodb_path; + $command .= " -path_base $outroot" if defined $outroot; + $command .= (" -dtime_addstar " . ((DateTime->now->mjd - $mjd_start) * 86400)); + # $command .= " -minidvodb_name $minidvodb_name" if defined $minidvodb_name; don't think we want it recorded (not sure) + $command .= " -dbname $dbname" if defined $dbname; + print $command; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/addstar_run.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/addstar_run.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/addstar_run.pl (revision 41105) @@ -0,0 +1,476 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $addtool = can_run('addtool') or (warn "Can't find addtool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); + +# these are only used by addstar_run, not addstar_multi +my $fftool = can_run('fftool') or (warn "Can't find fftool" and $missing_tools = 1); +my $loadgalphot = can_run('loadgalphot') or (warn "Can't find loadgalphot" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} +my $minidvodb_path; + +my ( $add_id, $camera, $stage, $stage_id, $stage_extra1, $outroot, $stageroot, $dbname, $reduction, $dvodb, $minidvodb, $minidvodb_name, $minidvodb_group, $image_only, $verbose, $no_update, + $no_op, $redirect, $save_temps); +GetOptions( + 'add_id=s' => \$add_id, # Camtool identifier + 'camera|c=s' => \$camera, # Camera + 'stage|s=s' => \$stage, # Camera + 'stage_id|w=s' => \$stage_id, + 'stage_extra1|w=s' => \$stage_extra1, # the number for a staticskymulti (for finding cmf), or stack_id + 'dbname|d=s' => \$dbname, # Database name + 'outroot|w=s' => \$outroot, # output file base name + 'stageroot|w=s' => \$stageroot, # stage root name. + 'reduction=s' => \$reduction, # Reduction class + 'dvodb|w=s' => \$dvodb, # output DVO database + 'minidvodb_name|w=s'=> \$minidvodb_name, # miniDVO database name + 'minidvodb_group|w=s' => \$minidvodb_group, # miniDVO database group + 'minidvodb' => \$minidvodb, # use minidvodb? + 'image-only' => \$image_only, # Print to stdout + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --add_id --camera --outroot --dvodb --stageroot --stage --dbname", + -exitval => 3, + ) unless + defined $stage and + defined $add_id and + defined $outroot and + defined $stageroot and + defined $dvodb and + defined $dbname and + defined $camera; +if ($stage =~ /cam/ && !defined $stage_id) { + my_die("cam stage requires -stage_id", $add_id, 3); + +} +if ($minidvodb && !defined($minidvodb_group)) { + my_die( "missing minidvodb_group", $add_id, 3 ); + } +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $add_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot) or &my_die("Missing entry from camera config", $add_id, $PS_EXIT_CONFIG_ERROR); + +if ($redirect) { + $ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $add_id, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Output products +$ipprc->outroot_prepare($outroot); + + +# +# Step 1: sort out reductions / recipes +# + + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +#if ($stage =~/diff/) { +# $reduction = 'ADDSTAR'; +#} +#if ($stage =~/fullforce/) { +# $reduction = 'ADDSTAR'; +#} + +if ($stage eq 'fullforce') { + $reduction='DEFAULT'; + #hardwired because why not +} +elsif ($stage eq 'fullforce_summary') { + $reduction = 'DEFAULT'; +} +elsif ($stage eq 'diff') { + $reduction='DEFAULT'; + #hardwired because why not +} + +my $recipe_addstar = $ipprc->reduction($reduction, 'ADDSTAR'); +# XXX This is now not used: do we still need it? +if ($stage eq 'cam') { + $recipe_addstar = $ipprc->reduction($reduction, 'ADDSTAR'); # Recipe to use +} +elsif ($stage eq 'stack') { + $recipe_addstar = $ipprc->reduction($reduction, 'ADDSTAR_STACK'); # Recipe to use +} +elsif ($stage eq 'skycal') { + $recipe_addstar = $ipprc->reduction($reduction, 'ADDSTAR'); # Recipe to use +} +#if ($stage =~/staticsky/) { +# $recipe_addstar = $ipprc->reduction($reduction, 'ADDSTAR_STATICSKY'); # Recipe to use +#} + + + +&my_die("Unrecognised ADDSTAR recipe", $add_id, $PS_EXIT_CONFIG_ERROR) unless defined $recipe_addstar; + + +# the camera configurations should define the psastro output to be a single file (MEF), regardless of the inputs + +# +# Step 2: Determine where sources should come from, modify them as needed. +# + + +# it was PSASTRO.OUTPUT + +my $fpaObjects = $ipprc->filename("PSASTRO.OUTPUT", $stageroot) or &my_die("Missing entry from camera config", $add_id, $PS_EXIT_CONFIG_ERROR); +my $fpaObjectsAlt = $fpaObjects; + +if ($stage eq 'skycal') { + #should be ok for skycal? + print "using $fpaObjects for $stage\n"; +} +elsif ($stage eq 'diff') { + print "using $fpaObjects for $stage\n"; +} +elsif ($stage eq 'fullforce') { + print "using $fpaObjects for $stage\n"; +} + +if ($stage eq 'cam') { + # if it is cam stage we need to be careful when grabbing the filename. + # This breaks down into a few steps: + + #get info about the cam_id + my $magicked; + { + my $mdcParser = PS::IPP::Metadata::Config->new; + my $command = "$camtool -processedexp -cam_id " . $stage_id; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get info on camRun", $add_id, $PS_EXIT_SYS_ERROR) unless $success; + if (scalar @$stdout_buf == 0 ) { #it lists nothing if it is the first + &my_die( "empty camRun", $add_id, $PS_EXIT_SYS_ERROR); + print "listing nothing\n"; + } else { + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $add_id, $PS_EXIT_PROG_ERROR); + #this fails if there is nothing listed. I checked. + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $add_id, $PS_EXIT_PROG_ERROR); + my $comp = $$components[0]; + my $mparsed = $comp->{magicked}; + + if (!defined($mparsed)) { + &my_die("Unable to parse magicked", $add_id, $PS_EXIT_PROG_ERROR); + } #but just to make sure, have it grab a minidvodb_name, to make sure it's not junk. + print "found a value for magicked:$mparsed\n"; + $magicked = $mparsed; + } + + #is this cam_id magicked or not? + if ($magicked) { + $stage_extra1 = $magicked; + $fpaObjects = $ipprc->destreaked_filename("$fpaObjects") or &my_die("Missing entry from camera config", $add_id, $PS_EXIT_CONFIG_ERROR); + print "cam_id is magicked, using $fpaObjects for the cam smf\n"; + } else { + print "cam_id is NOT magicked, using $fpaObjects for the cam smf\n"; + } + } +} + +if (($stage eq 'stack') || + ($stage eq 'skycal') || + ($stage eq 'diff') || + ($stage eq 'fullforce')|| + ($stage eq 'fullforce_summary')) { + $fpaObjects =~ s/smf$/cmf/; + $fpaObjectsAlt =~ s/smf$/cmf/; +} + +my $fpaObjects1; +my $fpaObjects2; +my $checkalt = 0; +if ($stage eq 'staticsky') { + $checkalt = 1; + my $sources = $ipprc->filename("PSPHOT.OUT.CMF.MEF", $stageroot); #this is mostly rigtht except the .cmf needs either + # .000.cmf or .stk.xxxxx.cmf + print "$sources\n\n\n"; + &my_die( "can't find the filter_num for staticsky_multi, giving up.", $add_id, $PS_EXIT_SYS_ERROR) unless (defined $stage_extra1); + + + $fpaObjects1 = $sources; + $fpaObjects2 = $sources; + $fpaObjects = $sources; + + my $nice_num = sprintf ("%03d", $stage_extra1); + + $fpaObjects1 =~ s/cmf$/stk.$stage_extra1.cmf/; + $fpaObjects2 =~ s/cmf$/$nice_num.cmf/; #this make it look for .001.cmf, etc + # we have 3 of them to try + my $realFile = $ipprc->file_resolve($fpaObjects); + my $realFile1 = $ipprc->file_resolve($fpaObjects1); + my $realFile2 = $ipprc->file_resolve($fpaObjects2); + if (!defined($realFile1)) { + if (!defined($realFile2)) { + print "using $fpaObjects\n"; + + } else { + print "using $fpaObjects2\n"; + $fpaObjects = $fpaObjects2; + } + + } else { + print "using $fpaObjects1\n"; + $fpaObjects = $fpaObjects1; + } +} + + +# +# Step 3 Set up addtool/loadgalphot commands. +# + +my $traceDest = $ipprc->filename("TRACE.EXP", $outroot) or &my_die("Missing entry from camera config", $add_id, $PS_EXIT_CONFIG_ERROR); + +# convert supplied DVO database name to UNIX filename +my $dvodbReal; +if (defined $dvodb) { + $dvodbReal = $ipprc->dvo_catdir( $dvodb ); # catdir for DVO + $dvodbReal = $ipprc->convert_filename_absolute( $dvodbReal ) or &my_die("can't get path for dvodb", $add_id, $PS_EXIT_CONFIG_ERROR); +} + +my $dtime_addstar = 0; +if (defined $dvodbReal) { + if ($minidvodb) { + my $command = "$addtool -listminidvodbrun "; + $command .= " -minidvodb_group $minidvodb_group" if defined $minidvodb_group; + $command .= " -minidvodb_name $minidvodb_name" if defined $minidvodb_name; + $command .= " -state 'active' -limit 1"; + $command .= " -dbname $dbname" if defined $dbname; + print $command; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get active minidvodb_name", $add_id, $PS_EXIT_SYS_ERROR) unless $success; + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $add_id, $PS_EXIT_PROG_ERROR); + + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $add_id, $PS_EXIT_PROG_ERROR); + my $comp = $$components[0]; + $minidvodb_path = $comp->{minidvodb_path}; + $minidvodb_name = $comp->{minidvodb_name}; + + if (!defined($minidvodb_path)) { + &my_die("Unable to parse minidvodb_path", $add_id, $PS_EXIT_PROG_ERROR); + } + if (!defined($minidvodb_name)) { + &my_die("Unable to parse minidvodb_name", $add_id, $PS_EXIT_PROG_ERROR); + } + } + else { + $minidvodb_path = $dvodbReal; + } + + unless ($no_op) { + print "$dvodbReal\n"; + ## addstar can either save the full set of detections, or just + ## the image metadata, in the dvodb. this is set in the + ## database table addRun + + # addstar requires the user to have a valid .ptolemyrc which + # in turn points at ippconfig/dvo.site + + # get the names for the camera and the real input file + my $camdir = $ipprc->dvo_cameradir(); # Camera directory for addstar + + my $realFile = $ipprc->file_resolve($fpaObjects) or &my_die("Unable to resolve $fpaObjects", $add_id, $PS_EXIT_SYS_ERROR); + + # most cameras use CHIP_HEADER. other exceptions: + # gpc1 @ camera : PHU_HEADER + # gpc1 @ staticsky : NOMINAL (is uncalibrated) + + # temporary hard-wired info + my $zeroPointOption = "CHIP_HEADER"; + my $zeroPointKeyword = "ZPT_OBS"; + if (($camdir =~ /gpc1/) && ($stage =~ /staticsky/)) { + $zeroPointOption = "NOMINAL"; + } + if (($camdir =~ /gpc1/) && ($stage =~ /cam/)) { + $zeroPointOption = "PHU_HEADER"; + } + if ($stage eq "diff") { + $zeroPointKeyword = "FPA.ZP"; + } + + my $command; + + if ($stage ne 'fullforce_summary') { +# print "IN ADDSTAR VERSION\n"; + # require a defined output dvo database to run addstar (ie, refuse to use the .ptolemyrc default) + $command = "$addstar -update"; # XXX optionally set -update? + $command .= " -D CAMERA $camdir"; + $command .= " -D CATDIR $minidvodb_path"; + $command .= " -D ZERO_POINT_OPTION $zeroPointOption"; + $command .= " -D ZERO_POINT_KEYWORD $zeroPointKeyword"; + $command .= " $realFile"; + $command .= " -use-name $fpaObjects"; # DVO wants the neb-name as a file reference + $command .= " -image" if $image_only; + if ($stage =~ /staticsky/) { + $command .= " -accept-astrom -quick-airmass"; + } #careful here - this matches staticsky and staticsky_multi + if ($stage =~ /skycal/) { + $command .= " -quick-airmass"; + } #careful here - this matches staticsky and staticsky_multi + if ($stage =~ /diff/) { + $command .= " -accept-astrom"; + } + if ($stage =~ /fullforce/) { + $command .= " -accept-astrom -xrad"; + } + } + else { # Full force summary case +# print "IN LOADGALPHOT VERSION\n"; + # We need to know the filter to set up the photcode, as the summaries do not include that in the header. + # We /could/ set up the addtool stuff to pass that in to the script when needed, but that would require adding + # a lot of extra hooks and option handlers. Therefore, call out to fftool, and get the filter that way, and + # construct the correct photcode. + + my $photcode = ''; + { + my $ff_command = "$fftool -dbname ${dbname} -summary -ff_id ${stage_id}"; + print "$ff_command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $ff_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to fetch filter via fftool: $error_code", $add_id, $error_code); + } + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine ff summary information.", $add_id, $error_code); + my $metadata = parse_md_list($MDlist); + my $ffSummary = $metadata->[0]; + my $filter = $ffSummary->{filter}; + my $stack_id = $ffSummary->{stack_id}; + + $filter =~ s/\.00000//; + $photcode = "GPC1.${filter}.ForcedWarp"; + } + + $command = "$loadgalphot -v "; + $command .= " -D CAMERA $camdir "; + $command .= " -D CATDIR $minidvodb_path "; + $command .= " $realFile "; + $command .= " -p $photcode "; + $command .= " -image-id $stage_id "; + } + + my $mjd_addstar_start = DateTime->now->mjd; # MJD of starting script + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform addstar: $error_code", $add_id, $error_code); + } + $dtime_addstar = 86400.0*(DateTime->now->mjd - $mjd_addstar_start); # MJD of starting script + } +} + +# This needs to be updated when addtool is written. BROKEN +my $fpaCommand = "$addtool -addprocessedexp"; +$fpaCommand .= " -add_id $add_id"; +$fpaCommand .= " -dtime_addstar $dtime_addstar"; + +$fpaCommand .= " -path_base $outroot"; +$fpaCommand .= " -dvodb_path $minidvodb_path" if defined $minidvodb_path; +$fpaCommand .= " -minidvodb_name $minidvodb_name" if defined $minidvodb_name; +$fpaCommand .= " -dbname $dbname" if defined $dbname; + +$fpaCommand .= " -stage_extra1 $stage_extra1" if defined $stage_extra1; + +print $fpaCommand; + +# Add the result into the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $fpaCommand, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to add result to database: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $fpaCommand\n"; +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $add_id = shift; # Camtool identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $add_id and not $no_update) { + my $command = "$addtool -add_id $add_id"; + $command .= " -addprocessedexp"; + $command .= " -fault $exit_code"; + $command .= " -dvodb_path $minidvodb_path" if defined $minidvodb_path; + $command .= " -path_base $outroot" if defined $outroot; + $command .= (" -dtime_addstar " . ((DateTime->now->mjd - $mjd_start) * 86400)); + # $command .= " -minidvodb_name $minidvodb_name" if defined $minidvodb_name; don't think we want it recorded (not sure) + $command .= " -stage_extra1 $stage_extra1" if defined $stage_extra1; + $command .= " -dbname $dbname" if defined $dbname; + print $command; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/automate_stacks.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/automate_stacks.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/automate_stacks.pl (revision 41105) @@ -0,0 +1,1632 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use DateTime; + +# +# Set up +################################################################################ + +my $missing_tools = 0; +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $dqstatstool = can_run('dqstatstool') or (warn "Can't find dqstatstool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $stacktool= can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $mkBTpcontrol = can_run('make_burntool_pcontrol.pl') or (warn "Can't find make_burntool_pcontrol.pl" and $missing_tools = 1); +my $moondata = can_run('moondata') or (warn "Can't find moondata" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $db; +my $debug = 0; +my %metadata_out = (); +$metadata_out{nsState} = 'UNDEFINEDERROR'; +my $loghead; +chomp($loghead = `date`); +print STDERR 'Starting: ' . $loghead . ' ' . $0 . ' ' . (join ' ', @ARGV) . "\n"; + +# Grab options +my ( $date, $camera, $dbname, $logfile, $verbose, $manual); +my ( $help, $isburning, $force_stack_count, $test_mode, $this_target_only, $this_filter_only, $this_mode_only, $check_mode, $burntool_stats); +my ( $check_registration, $define_burntool, $queue_burntool, $check_chips, $queue_chips); +my ( $check_stacks, $queue_stacks, $check_sweetspot, $queue_sweetspot, $check_diffs, $queue_diffs, $clean_old); +my ( $check_detrends, $queue_detrends, $check_dqstats, $queue_dqstats); +my ( $confirm_stacks, $check_confirm_stacks ); + +GetOptions( + 'help|h' => \$help, + 'date=s' => \$date, # night to make stacks for + 'camera=s' => \$camera, # camera + 'dbname=s' => \$dbname, # Database name + 'logfile=s' => \$logfile, + 'verbose' => \$verbose, + 'debug' => \$debug, + 'isburning' => \$isburning, + 'force_stack_count' => \$force_stack_count, + 'check' => \$check_mode, + 'test_mode' => \$test_mode, + 'burntool_stats' => \$burntool_stats, + 'this_target_only=s' => \$this_target_only, + 'this_filter_only=s' => \$this_filter_only, + 'this_mode_only=s' => \$this_mode_only, + 'check_registration' => \$check_registration, + 'define_burntool' => \$define_burntool, + 'queue_burntool' => \$queue_burntool, + 'check_chips' => \$check_chips, + 'queue_chips' => \$queue_chips, + 'check_stacks' => \$check_stacks, + 'queue_stacks' => \$queue_stacks, + 'confirm_stacks' => \$confirm_stacks, + 'check_confirm_stacks' => \$check_confirm_stacks, + 'check_sweetspot' => \$check_sweetspot, + 'queue_sweetspot' => \$queue_sweetspot, + 'check_detrends' => \$check_detrends, + 'queue_detrends' => \$queue_detrends, + 'check_dqstats' => \$check_dqstats, + 'queue_dqstats' => \$queue_dqstats, + 'check_diffs' => \$check_stacks, + 'queue_diffs' => \$queue_stacks, + 'clean_old' => \$clean_old, + ) or pod2usage ( 2 ); +pod2usage( -msg => +"USAGE: automate_stacks.pl + Options: + --help This help. + --date YYYY-MM-DD Work on this date (defaults to today GMT). + --camera Default GPC1. + --dbname Default gpc1. + --verbose + --isburning Signal that we are currently burntooling. + --force_stack_count Force the chip/warp counts. + --this_target_only Process only a single target. + --this_filter_only Process only a single filter. + --this_mode_only Process only a single clean mode. + --burntool_stats Display Nexp Nimfile Nburntooled Nqueued for check_chips. + Modes: + --check_registration Confirm the data downloaded correctly. + --define_burntool Determine date ranges for burntool. + --queue_burntool Issue commands to burntool data. + --check_chips Confirm that chips can be built. + --queue_chips Issue chiptool commands to queue chips. + --check_stacks Confirm that stacks can be built. + --queue_stacks Issue stacktool commands to queue stacks. + --check_sweetspot See if we should queue SweetSpot stacks. + --queue_sweetspot Issue stacktool commands to queue SweetSpot stacks. + --check_detrends Confirm that detrend verify runs can be built. + --queue_detrends Issue dettool commands to queue detrend verify runs. + --check_dqstats Confirm that dqstats tables can be built. + --queue_dqstats Issue dqstatstool commands to queue dqstat tables. + --check_diffs Confirm that diffs can be done. + --queue_diffs Issue difftool commands to queue diffs. + --clean_old Mark old data 'goto_cleanup'.\n", + -exitval => 2, ) if (defined($help)); +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Choose a mode: --check_registration --check_burntool --queue_chips --queue_stacks --dbname", + -exitval => 3, + ) unless + defined $check_registration or defined $define_burntool or defined $queue_burntool or + defined $queue_chips or defined $queue_stacks or $queue_sweetspot or $queue_detrends or $queue_dqstats or + defined $check_chips or defined $check_stacks or $check_sweetspot or $check_detrends or $check_dqstats or + defined $test_mode or defined $clean_old or defined $check_mode or + defined $confirm_stacks or defined $burntool_stats or defined $dbname; + +# Configurable parameters from our config file. +my @target_list = (); +my @filter_list = (); +my %distribution_list = (); +my %tessID_list = (); +my %obsmode_list = (); +my %object_list = (); +my %comment_list= (); +my %cleanmods_list = (); +my %stackable_list = (); +my %extra_processing = (); +my %reduction_class = (); +my %macro_formats = (); +my @unrecoverable_quality = (); +my @detrend_list = (); +my %dettype_list = (); +my %exptype_list = (); +my %refID_list = (); +my %refIter_list = (); +my %detfilter_list = (); +my %detmax_list = (); +my @mode_list = (); +my %clean_commands = (); +my %clean_retention = (); +my %noclean_list = (); +my %clean_alternate = (); +# Grab the configuration data. +my $conf_cmd = "$ppConfigDump -dump-recipe NIGHTLY_SCIENCE -"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $date, $PS_EXIT_SYS_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; +my $metadata = $mdcParser->parse(join "", @$stdout_buf); +foreach my $entry (@{ $metadata }) { + if (@{ $entry }{name} eq 'CLEAN_MODES') { + my @mode_data = @{ ${ $entry }{value} }; + my $this_mode = ''; + foreach my $mentry (@mode_data) { + if (${ $mentry }{name} eq 'MODE') { + $this_mode = ${ $mentry }{value}; + push @mode_list, $this_mode; + } + elsif (${ $mentry }{name} eq 'COMMAND') { + $clean_commands{$this_mode} = ${ $mentry }{value}; + } + elsif (${ $mentry }{name} eq 'RETENTION_TIME') { + $clean_retention{$this_mode} = ${ $mentry }{value}; + } + elsif (${ $mentry }{name} eq 'ALTERNATE_CMD') { + $clean_alternate{$this_mode} = ${ $mentry }{value}; + } + } + } + elsif (${ $entry }{name} eq 'FILTERS') { + push @filter_list, ${ $entry }{value}; + } + elsif (${ $entry }{name} eq 'UNRECOVERABLE_QUALITY') { + push @unrecoverable_quality, ${ $entry }{value}; + } + elsif (${ $entry }{name} eq 'MACRO_DEFINITIONS') { + my @macro_data = @{ ${ $entry }{value} }; + my $this_mode = ''; + foreach my $mentry (@macro_data) { + if (${ $mentry }{name} eq 'PROC_MODE') { + $this_mode = ${ $mentry }{value}; + } + elsif (${ $mentry }{name} eq 'MACRO') { + $macro_formats{$this_mode} = ${ $mentry }{value}; + } + } + } + elsif (${ $entry }{name} eq 'TARGETS') { + my @target_data = @{ ${ $entry }{value} }; + my $this_target = ''; + foreach my $tentry (@target_data) { + if (${ $tentry }{name} eq 'NAME') { + $this_target = ${ $tentry }{value}; + push @target_list, $this_target; + $distribution_list{$this_target} = $this_target; + } + elsif (${ $tentry }{name} eq 'DISTRIBUTION') { + $distribution_list{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'TESS') { + $tessID_list{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'OBSMODE') { + $obsmode_list{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'OBJECT') { + $object_list{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'COMMENT') { + $comment_list{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'STACKABLE') { + $stackable_list{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'EXTRA_PROCESSING') { + $extra_processing{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'REDUCTION') { + $reduction_class{$this_target} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'NOCLEAN') { + $noclean_list{$this_target} = ${ $tentry }{value}; + } + else { + if (exists($clean_commands{ ${ $tentry }{name} })) { + $cleanmods_list{$this_target}{${ $tentry }{name} } = ${ $tentry }{value}; + } + } + } + } + elsif (${ $entry }{name} eq 'DETRENDS') { + my @detrend_data = @{ ${ $entry }{value} }; + my $this_detrend = ''; + foreach my $dentry (@detrend_data) { + if (${ $dentry }{name} eq 'NAME') { + $this_detrend = ${ $dentry }{value}; + push @detrend_list, $this_detrend; + } + elsif (${ $dentry }{name} eq 'DETTYPE') { + $dettype_list{$this_detrend} = ${ $dentry }{value}; + } + elsif (${ $dentry }{name} eq 'EXPTYPE') { + $exptype_list{$this_detrend} = ${ $dentry }{value}; + } + elsif (${ $dentry }{name} eq 'REF_ID') { + $refID_list{$this_detrend} = ${ $dentry }{value}; + } + elsif (${ $dentry }{name} eq 'REF_ITER') { + $refIter_list{$this_detrend} = ${ $dentry }{value}; + } + elsif (${ $dentry }{name} eq 'FILTER') { + $detfilter_list{$this_detrend} = ${ $dentry }{value}; + } + elsif (${ $dentry }{name} eq 'MAX') { + $detmax_list{$this_detrend} = ${ $dentry }{value}; + } + } + } +} + +unless(defined($date)) { + my @trash = gmtime; + $trash[5] += 1900; + $trash[4] += 1; + $date = sprintf("%4d-%02d-%02d",$trash[5],$trash[4],$trash[3]); +} +unless(defined($camera)) { + $camera = 'GPC1'; +} + +if (defined($this_target_only)) { + foreach my $t (@target_list) { + if ($t eq $this_target_only) { + @target_list = ($this_target_only); + last; + } + } + die("$this_target_only is invalid.") if ($#target_list != 0); +} + +if (defined($this_filter_only)) { + foreach my $t (@filter_list) { + if ($t eq $this_filter_only) { + @filter_list = ($this_filter_only); + last; + } + } + die("$this_filter_only is invalid.") if ($#filter_list != 0); +} + +if (defined($this_mode_only)) { + foreach my $t (@mode_list) { + if ($t eq $this_mode_only) { + @mode_list = ($this_mode_only); + last; + } + } + die("$this_mode_only is invalid.") if ($#mode_list != 0); +} + +# +# Mode selection +################################################################################ +if (defined($test_mode)) { + $debug = 1; + my $z; + foreach $z (@target_list) { + print "TARGET: $z $tessID_list{$z} $obsmode_list{$z} $object_list{$z} $comment_list{$z} $stackable_list{$z} $reduction_class{$z}\n"; + } + foreach $z (@filter_list) { + print "FILTER: $z\n"; + } + foreach $z (keys (%clean_commands)) { + print "CLEAN: $z $clean_commands{$z} $clean_retention{$z}\n"; + } + foreach $z (keys (%macro_formats)) { + print "MACROS: $z $macro_formats{$z}\n"; + } + +} + +if (defined($check_registration) || defined($test_mode) || defined($check_mode)) { + $metadata_out{nsState} = 'NEW'; + my ($Nsummit_exp,$Nfaults) = check_summit_copy($date); + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} + +if (defined($check_dqstats) || defined($test_mode)) { + $metadata_out{nsState} = 'CHECKDQSTATS'; + &execute_dqstats($date,"pretend"); + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} +if (defined($queue_dqstats) || defined($test_mode)) { + $metadata_out{nsState} = 'QUEUEDQSTATS'; + &execute_dqstats($date); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} + +if (defined($check_detrends) || defined($test_mode) || defined($check_mode)) { + $metadata_out{nsState} = 'CHECKDETRENDS'; + &execute_detrends($date,"pretend"); + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} +if (defined($queue_detrends)) { + $metadata_out{nsState} = 'QUEUEDETRENDS'; + &execute_detrends($date); + return_metadata($date); + exit(0); +} + +if (defined($define_burntool) || defined($test_mode)) { + $metadata_out{nsState} = 'QUEUEBURNING'; + &find_burntool_ranges($date); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} +if (defined($queue_burntool) || defined($test_mode)) { + $metadata_out{nsState} = 'BURNING'; + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} + +if (defined($check_chips) || defined($test_mode) || defined($check_mode)) { + $metadata_out{nsState} = 'QUEUECHIPS'; + &execute_chips($date,"pretend"); + if (($metadata_out{nsState} eq 'NEEDSBURNING')&&(defined($isburning))) { + $metadata_out{nsState} = 'BURNING'; + } + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} +if (defined($queue_chips)) { + $metadata_out{nsState} = 'TOWARP'; + &execute_chips($date); + return_metadata($date); + exit(0); +} + +if (defined($check_stacks) || defined($test_mode) || defined($check_mode)) { + $metadata_out{nsState} = 'TOWARP'; + &execute_stacks($date,"pretend"); + if ($metadata_out{nsState} eq 'FORCETOWARP') { + $metadata_out{nsState} = 'TOWARP'; + } + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} +if (defined($queue_stacks)) { + $metadata_out{nsState} = 'STACKING'; + &execute_stacks($date); + if ($metadata_out{nsState} eq 'QUEUESTACKING') { + $metadata_out{nsState} = 'STACKING_POSSIBLE_ERROR'; + } + return_metadata($date); + exit(0); +} + +if (defined($check_confirm_stacks) || defined($test_mode) || defined($check_mode)) { + $metadata_out{nsState} = 'CONFIRM_STACKING'; + &confirm_stacks($date,"pretend"); + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} +if (defined($confirm_stacks)) { + $metadata_out{nsState} = 'CONFIRM_STACKING'; + &confirm_stacks($date); + return_metadata($date); + exit(0); +} + +if (defined($check_sweetspot) || defined($test_mode) || defined($check_mode)) { + $metadata_out{nsState} = 'CHECKSWEETSPOT'; + &execute_sweetspot($date,"pretend"); + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} +if (defined($queue_sweetspot)) { + $metadata_out{nsState} = 'CHECKSWEETSPOT'; + &execute_sweetspot($date); + return_metadata($date); + exit(0); +} + +if (defined($check_diffs) || defined($queue_diffs)) { + die("Diffs are currently not implemented."); +} + +if (defined($clean_old) || defined($test_mode)) { + if (defined($test_mode)) { + &execute_cleans($date,"pretend"); + } + else { + &execute_cleans($date); + } + unless (defined($test_mode)) { exit(0); } +} +exit(0); +# +# Registration +################################################################################ + +sub check_summit_copy { + my $date = shift; + my $db = init_gpc_db(); + + # largely stolen from Bill's checkexp program. + + my $sth = " SELECT exp_name, summitExp.dateobs AS registered, rawExp.dateobs, summitExp.imfiles, "; + $sth .= " summitExp.fault AS summit_fault, pzDownloadExp.state AS download_state, "; + $sth .= " count(pzDownloadImfile.class_id) AS download_count, newExp.state AS newExp_state, newExp.exp_id, summitExp.exp_type"; + $sth .= " FROM summitExp LEFT JOIN pzDownloadExp USING(exp_name) LEFT JOIN pzDownloadImfile USING(exp_name) "; + $sth .= " LEFT JOIN newExp ON exp_name = tmp_exp_name LEFT JOIN rawExp USING(exp_id, exp_name) "; + $sth .= " WHERE date(summitExp.dateobs) >= '${date}T00:00:00' AND date(summitExp.dateobs) <= '${date}T23:59:59' "; + $sth .= " GROUP BY exp_name ORDER BY summitExp.dateobs "; + + my $data_ref = $db->selectall_arrayref( $sth ); + + my $Nsummit_exps = 0; + my $Nsummit_faults = 0; + my $Ndownload_faults = 0; + my $Nregister_faults = 0; + +# my_trace($sth,$data_ref,$#{ $data_ref }); + + foreach my $row_ref (@{ $data_ref }) { + my ($exp_name,$registered,$dateobs,$imfiles,$summit_fault, + $download_state,$download_count,$new_state,$exp_id,$exp_type) = @{ $row_ref }; + $Nsummit_exps++; + if ($summit_fault) { + print STDERR "check_summit_copy: $date $exp_name has summit_fault $summit_fault"; + if (($exp_type ne 'OBJECT')||($exp_name =~ /^c.*/)) { + print STDERR " (but I don't care).\n"; + } + else { + print STDERR "\n"; + $Nsummit_faults++; + } + } + elsif (!$download_state or $download_state eq 'run') { + print STDERR "check_summit_copy: $date $exp_name has download_state $download_state"; + if (($exp_type ne 'OBJECT')||($exp_name =~ /^c.*/)) { + print STDERR " (but I don't care).\n"; + } + else { + print STDERR "\n"; + $Ndownload_faults++; + } + } + elsif (!$new_state or $new_state eq 'run' ) { + print STDERR "check_summit_copy: $date $exp_name has new_state $new_state"; + if (($exp_type ne 'OBJECT')||($exp_name =~ /^c.*/)) { + print STDERR " (but I don't care).\n"; + } + else { + print STDERR "\n"; + $Nregister_faults++; + } + } + } + + my $Nfaults = $Nsummit_faults + $Ndownload_faults + $Nregister_faults; + if ($Nsummit_exps == 0) { + print STDERR "No exposures were found on the summit for $date.\n"; + $metadata_out{nsState} = 'DROP'; + } + elsif ($Nfaults != 0) { + print STDERR "There were faults while downloading the exposures for $date.\n"; + $metadata_out{nsState} = 'NEW'; + } + else { + print STDERR "Summit copy and Registration have succeeded for $date.\n"; + $metadata_out{nsState} = 'REGISTERED'; + } + + return($Nsummit_exps,$Nfaults); +} + +# +# Burntool +################################################################################ + +sub get_goodBTvalue { + my $mdcParser = PS::IPP::Metadata::Config->new; + + my $config_cmd = "$ppConfigDump -camera $camera -get-key BURNTOOL.STATE.GOOD"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $config_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", 0, 0, 0, $PS_EXIT_SYS_ERROR); + } + my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", 0, 0, 0, $PS_EXIT_SYS_ERROR); + my $burntoolStateGood = 999; + foreach my $cfg (@$recipeData) { + if ($cfg->{name} eq 'BURNTOOL.STATE.GOOD') { + $burntoolStateGood = $cfg->{value}; + } + } + if ($burntoolStateGood == 999) { + &my_die("Failed to determine BURNTOOL.STATE.GOOD", $burntoolStateGood, 0, 0, $PS_EXIT_SYS_ERROR); + } + return($burntoolStateGood); +} + +sub verify_burntool { + my $exp_id = shift; + my $burntoolStateGood = shift; + + my $db = init_gpc_db(); + + my $sth = "SELECT exp_id,exp_name,obs_mode,dateobs,class_id,burntool_state,comment FROM rawImfile WHERE exp_id = $exp_id"; + my $data_ref = $db->selectall_arrayref( $sth ); + + my $Nimfiles = 0; + my $Nburntooled = 0; + + foreach my $row_ref (@{ $data_ref }) { + my ($exp_id,$exp_name, $obs_mode,$dateobs,$class_id,$burntool_state,$comment) = @{ $row_ref }; + $Nimfiles++; + if (abs($burntool_state) == $burntoolStateGood) { + $Nburntooled++; + } + } + return($Nimfiles,$Nburntooled); +} + +sub find_burntool_ranges { + my $date = shift; + # Much cleaner than reimplementing that mess here + my $command = "$mkBTpcontrol -d $date -b"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + +# if ($#{ $stderr_buf } > -1) { +# $metadata_out{nsState} = 'ERROR'; +# return(1); +# } + + my $N = 0; + my @burntool_entries = split /\n/, (join '', @$stdout_buf); + foreach my $row (@burntool_entries) { + my ($trash,$start,$end); + (undef,$trash,$start,$end) = (split /\s+/,$row); + if ($trash ne 'burntool') { + $metadata_out{nsState} = 'ERROR'; + return(1); + } + for (my $class_counter = 0; $class_counter < 60; $class_counter++) { + $metadata_out{"bt${N}Begin"} = $start; + $metadata_out{"bt${N}End"} = $end; + $metadata_out{"bt${N}Class"} = $class_counter; + $metadata_out{"bt${N}Status"} = 'NEW'; + $N++; + } + print STDERR "define_burntool: $row\n"; + } + $metadata_out{btN} = $N - 1; + $metadata_out{btNCounter} = 0; + add_to_macro_list('define_burntool',1,$date); + return(0); +} + +# +# Chips +################################################################################ + + +sub construct_chiptool_cmd { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $select = "-dateobs_begin ${date}T00:00:00 -dateobs_end ${date}T23:59:59 "; + $date =~ s/-//g; + + my $cmd = "$chiptool"; + $cmd .= " -simple -dbname $dbname -definebyquery -set_end_stage warp "; + $cmd .= " -set_label $label "; + $cmd .= " -set_workdir $workdir -set_dist_group $dist_group "; + $cmd .= " -set_tess_id $tess_id -set_data_group $data_group "; + if (defined($obs_mode)) { + $cmd .= " -obs_mode '$obs_mode' "; + } + if (defined($object)) { + $cmd .= " -object '$object' "; + } + if (defined($comment)) { + $cmd .= " -comment '$comment' "; + } + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + $cmd .= " $select "; + if ($debug == 1) { + $cmd .= " -pretend "; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub verify_uniqueness_chip { + my $exp_id = shift; + my $date = shift; + my $target = shift; + + my $db = init_gpc_db(); + $date =~ s/-//g; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $sth = "SELECT exp_id from chipRun where data_group = '$data_group' AND exp_id = $exp_id"; + my $data_ref = $db->selectall_arrayref( $sth ); + + return($#{ $data_ref } + 1); +} + +sub pre_chip_queue { + my $date = shift; + my $target = shift; + + my $command = construct_chiptool_cmd($date,$target) . ' -pretend '; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + + my $burntoolStateGood = get_goodBTvalue(); + my $Nimfiles = 0; + my $Nburntooled = 0; + my $Nalready = 0; + my @input_exposures = split /\n/, (join '', @$stdout_buf); + foreach my $entry (@input_exposures) { + my ($exp_id, @trash) = split /\s+/, $entry; + @trash = verify_burntool($exp_id,$burntoolStateGood); + $Nimfiles += $trash[0]; + $Nburntooled += $trash[1]; + + @trash = verify_uniqueness_chip($exp_id,$date,$target); + $Nalready += $trash[0]; + } + return($#input_exposures + 1,$Nimfiles,$Nburntooled,$Nalready); +} + +sub chip_queue { + my $date = shift; + my $target = shift; + + my $command = construct_chiptool_cmd($date,$target); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + $metadata_out{nsState} = 'TOWARP'; + + return(0); +} + +sub execute_chips { + my $date = shift; + my $pretend = shift; + my $exposures = 0; + + foreach my $target (@target_list) { + my ($Nexposures,$Nimfiles,$Nburntooled,$Nalready) = pre_chip_queue($date,$target); + if (defined($burntool_stats)) { + print "BTSTATS: $date $target $Nexposures $Nimfiles $Nburntooled $Nalready\n"; + } + + if ($Nexposures == 0) { + print STDERR "execute_chips: Target $target on $date had no exposures.\n"; + next; + } + if ($Nalready != 0) { + print STDERR "execute_chips: Not queueing $target on $date due to already existing exposures.\n"; + next; + } + if ($Nimfiles != $Nburntooled) { + print STDERR "execute_chips: Target $target on $date is not fully burntooled.\n"; + $metadata_out{nsState} = 'NEEDSBURNING'; + $exposures++; + next; + } + $exposures++; + unless(defined($pretend)) { + chip_queue($date,$target); + } + if (defined($pretend)) { + add_to_macro_list('check_chips',$stackable_list{$target},$date,$target); + } + else { + add_to_macro_list('queue_chips',$stackable_list{$target},$date,$target); + } + + } + if ($exposures == 0) { + $metadata_out{nsState} = 'DROP'; + } +} + + +# +# DQstats +################################################################################ + +sub construct_dqstats_cmd { + my $date = shift; + + my $select = "-dateobs_end ${date}T23:59:59 "; + + my $cmd = "$dqstatstool"; + $cmd .= " -simple -dbname $dbname -definebyquery "; + $cmd .= " $select "; + $cmd .= " -label %.nightlyscience "; + $cmd .= " -set_label dqstats.nightlyscience "; + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub pre_dqstats_queue { + my $date = shift; + + my $command = construct_dqstats_cmd($date) . ' -pretend '; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dqstatstool: $error_code",1,1,,$date, $PS_EXIT_SYS_ERROR); + } + + my @input_exposures = split /\n/, (join '', @$stdout_buf); + + return($#input_exposures + 1,1,1); +} + +sub dqstats_queue { + my $date = shift; + + my $command = construct_dqstats_cmd($date); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dqstatstool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + return(0); + +} +sub execute_dqstats { + my $date = shift; + my $pretend = shift; + my ($Nexposures,$Nchips,$Ncams) = pre_dqstats_queue($date); + if ($Nexposures == 0) { + print STDERR "execute_dqstats: No exposures on date $date.\n"; + } + elsif ($Ncams != $Nchips) { + print STDERR "execute_dqstats: Not done processing data through camera stage.\n"; + } + else { + unless(defined($pretend)) { + dqstats_queue($date); + } + if (defined($pretend)) { + add_to_macro_list('check_dqstats',1,$date); + } + else { + add_to_macro_list('queue_dqstats',1,$date); + } + } +} +# +# Detrend verification +################################################################################ + +sub construct_dettool_cmd { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$filter,$exp_type,$det_type,$ref_det_id,$ref_iter,$maxN) = get_dettool_parameters($date,$target); + + my $select = "-select_dateobs_begin ${date}T00:00:00 -select_dateobs_end ${date}T23:59:59 "; + my $use_limits = " -use_begin ${date}T00:00:00 -use_end ${date}T23:59:59 "; + $date =~ s/-//g; + + my $cmd = "$dettool"; +# $cmd .= " -pretend "; + $cmd .= " -simple -dbname $dbname -definebyquery -det_type $det_type "; + $cmd .= " -mode verify -ref_det_id $ref_det_id -ref_iter $ref_iter "; + $cmd .= " $select "; + $cmd .= " -inst $camera "; + $cmd .= " -select_exp_type $exp_type "; + $cmd .= " -select_filter $filter " if defined($filter); + $cmd .= " -workdir $workdir "; + $cmd .= " -label $label "; + $cmd .= " $use_limits "; + if ($maxN > 0) { + $cmd .= " -random_subset -random_limit $maxN "; + } + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub verify_uniqueness_detverify { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$filter,$exp_type,$det_type,$ref_det_id,$ref_iter,$maxN) = get_dettool_parameters($date,$target); + + my $db = init_gpc_db(); + my $sth = "SELECT * FROM detRun WHERE workdir = '$workdir' AND ref_det_id = $ref_det_id AND ref_iter = $ref_iter"; + my $data_ref = $db->selectall_arrayref( $sth ); + + return($#{ $data_ref } + 1); +} + +sub pre_detrend_queue { + my $date = shift; + my $target = shift; + + my $command = construct_dettool_cmd($date,$target) . ' -pretend '; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", 0,0, $date, $PS_EXIT_SYS_ERROR); + } + + my @input_exposures = split /\n/, (join '', @$stdout_buf); + return($#input_exposures + 1); +} + +sub detrend_queue { + my $date = shift; + my $target = shift; + + my $command = construct_dettool_cmd($date,$target); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + $metadata_out{nsState} = 'DETREND_QUEUED'; + return(0); + +} +sub execute_detrends { + my $date = shift; + my $pretend = shift; + my $exposures = 0; + foreach my $target (@detrend_list) { + my ($Nexposures) = pre_detrend_queue($date,$target); + if ($Nexposures == 0) { + print STDERR "execute_detrends: Target $target on $date had no exposures.\n"; + next; + } + $exposures++; + unless(defined($pretend)) { + detrend_queue($date,$target); + } + if (defined($pretend)) { + add_to_macro_list('check_detrends',1,$date,$target,"dettool"); + } + else { + add_to_macro_list('queue_detrends',1,$date,$target,"dettool"); + } + } + if ($exposures == 0) { + $metadata_out{nsState} = 'DETREND_DROP'; + } + if (($metadata_out{nsState} eq 'CHECKDETRENDS') && ($exposures > 0)) { + $metadata_out{nsState} eq 'QUEUEDETRENDS'; + } +} + +# +# SweetSpot Stacking +################################################################################ +sub construct_sweetspot_cmd { + my $date = shift; + my $target = 'SweetSpot'; + my $filter = 'w.00000'; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + # Dateobs begin end? + my ($dateobs_begin,$dateobs_end) = get_lunation_extent($date); + my $select = "-select_dateobs_begin ${dateobs_begin}T00:00:00 -select_dateobs_end ${dateobs_end}T00:00:00"; + my $cmd = "$stacktool"; + $cmd .= " -simple -dbname $dbname -definebyquery "; + $cmd .= " -set_label SweetSpot.refstack -select_label $label "; + $cmd .= " -set_workdir $workdir -set_dist_group $dist_group "; + $cmd .= " -select_filter $filter -set_data_group $data_group "; + $cmd .= " -select_good_frac_min 0.1 -select_fwhm_major_max 8.0 "; + $cmd .= " -min_num 7 -min_new 4"; + $cmd .= " $select "; + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub get_lunation_extent { + my $date = shift; + my ($year,$month,$day) = split /-/,$date; + my $dateobs_begin; + my $dateobs_end; + + my $dt = DateTime->new(year => $year, month => $month, day => $day, + hour => 0, minute => 0, second => 0, nanosecond => 0, + time_zone => 'Pacific/Honolulu'); + do { + $dt->subtract(days => 1); + my $ymd = $dt->ymd; + my $md_cmd = "moondata $ymd 0 0"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $md_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform moondata: $error_code", 0,0, $date, $PS_EXIT_SYS_ERROR); + } + my @result = split /\s+/,(join "\n", @$stdout_buf); + if (abs($result[6]) <= 0.5) { + $dateobs_end = $ymd; + } + } while (!defined($dateobs_end)); + + do { + $dt->subtract(days => 1); + my $ymd = $dt->ymd; + my $md_cmd = "moondata $ymd 0 0"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $md_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform moondata: $error_code", 0,0, $date, $PS_EXIT_SYS_ERROR); + } + my @result = split /\s+/,(join "", @$stdout_buf); + if (abs($result[6]) <= 0.5) { + $dateobs_begin = $ymd; + } + } while (!defined($dateobs_begin)); + + return($dateobs_begin,$dateobs_end); +} + +sub pre_sweetspot_queue { + my $date = shift; + my $command = construct_sweetspot_cmd($date) . ' -pretend '; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform sweetspot stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + my @stacks = split /\n/, (join '', @$stdout_buf); + my $Nstacks = $#stacks + 1; + + return(1,$Nstacks); +} + +sub sweetspot_queue { + my $date = shift; + my $command = construct_sweetspot_cmd($date); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform sweetspot stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + my @stacks = split /\n/, (join '', @$stdout_buf); + my $Nstacks = $#stacks + 1; + + return(1,$Nstacks); +} + +sub execute_sweetspot { + my $date = shift; + my $pretend = shift; + + my ($is_lunation_date,$Nstacks) = pre_sweetspot_queue($date); + if ($Nstacks == 0) { + print STDERR "execute_sweetspot: No new stacks to make ($Nstacks)\n"; + $metadata_out{nsState} = 'SS_EMPTY'; + return(); + } + if ($Nstacks < 10) { + print STDERR "execute_sweetspot: Too few new stacks to make ($Nstacks)\n"; + $metadata_out{nsState} = 'SS_FEW'; + return(); + } + if ($is_lunation_date == 0) { + print STDERR "execute_sweetspot: Invalid lunation date. ($date $is_lunation_date)\n"; + $metadata_out{nsState} = 'SS_ERROR'; + return(); + } + $metadata_out{nsState} = 'SS_QUEUE'; + $metadata_out{nsSweetSpot} = $Nstacks; + unless(defined($pretend)) { + $metadata_out{nsState} = 'SS_DONE'; + sweetspot_queue($date); + } + if (defined($pretend)) { + add_to_macro_list('check_sweetspot',1,$date); + } + else { + add_to_macro_list('queue_sweetspot',1,$date); + } +} + +# +# Stacking +################################################################################ + +sub construct_stacktool_cmd { + my $date = shift; + my $target = shift; + my $filter = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $select = "-select_dateobs_begin ${date}T00:00:00 -select_dateobs_end ${date}T23:59:59 "; + $date =~ s/-//g; + + my $cmd = "$stacktool"; +# $cmd .= ' -pretend -simple -dbname gpc1 -definebyquery -min_new 4 '; # Probably silly, but I want to be safe and not overwrite + $cmd .= " -simple -dbname $dbname -definebyquery "; + $cmd .= " -set_label $label -select_label $label "; + $cmd .= " -set_workdir $workdir -set_dist_group $dist_group "; + $cmd .= " -select_filter $filter -set_data_group $data_group "; + $cmd .= " -min_num 4"; + $cmd .= " -select_good_frac_min 0.05"; + $cmd .= " $select "; + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub verify_uniqueness_stack { + my $skycell = shift; + my $date = shift; + my $target = shift; + my $filter = shift; + + my $db = init_gpc_db(); + $date =~ s/-//g; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $sth = "SELECT skycell_id from stackRun where data_group = '$data_group' AND skycell_id = '$skycell' AND filter = '$filter' AND tess_id = '$tess_id'"; + my $data_ref = $db->selectall_arrayref( $sth ); + + return($#{ $data_ref } + 1); +} + +sub pre_stack_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + # check warp stage == chip stage + my $db = init_gpc_db(); + + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $where = " label = '$label' AND data_group = '$data_group' "; + + my $where_possibly_faulted = $where . " AND ( " ; + foreach my $acceptable_quality (@unrecoverable_quality) { + $where_possibly_faulted .= " quality = $acceptable_quality OR "; + } + $where_possibly_faulted .= " 0 )"; + + my $chip_sth = "SELECT * from chipRun WHERE (state = 'full' OR state = 'new') AND $where "; + my $cam_sth = "SELECT * from camRun JOIN camProcessedExp USING(cam_id) WHERE state = 'full' AND $where_possibly_faulted "; + my $warp_sth = "SELECT * from warpRun WHERE state = 'full' AND $where "; + + my $chip_ref = $db->selectall_arrayref( $chip_sth ); + my $cam_ref = $db->selectall_arrayref( $cam_sth ); + my $warp_ref = $db->selectall_arrayref( $warp_sth ); + + # check that we will be able to queue them up + my $command = construct_stacktool_cmd($date,$target,$filter) . ' -pretend '; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", $#{ $chip_ref },$#{ $warp_ref },$date, $PS_EXIT_SYS_ERROR); + } + + my $Nalready = 0; + + my @input_exposures = split /\n/, (join '', @$stdout_buf); + foreach my $entry (@input_exposures) { + my ($warp_tess_id,$skycell, @trash) = split /\s+/, $entry; + @trash = verify_uniqueness_stack($skycell,$date,$target,$filter); + $Nalready += $trash[0]; + } + + return($#input_exposures + 1, $#{ $chip_ref } + 1, $#{ $cam_ref } + $#{ $warp_ref } + 2, $Nalready); +} + +sub stack_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + + my $command = construct_stacktool_cmd($date,$target,$filter); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + + + return(0); +} + +sub execute_stacks { + my $date = shift; + my $pretend = shift; + foreach my $target (@target_list) { + foreach my $filter (@filter_list) { + if (exists($extra_processing{$target})) { + my ($Nexposures,$NprocChips,$NprocWarps,$Nalready) = pre_stack_queue($date,$target,$filter); + if ((!defined($force_stack_count))&&($NprocChips != $NprocWarps)) { # This makes me sad. :( + next; + } + if ($Nexposures == 0) { + if ($debug == 1) { + print STDERR "execute_stacks: Target $target in filter $filter on $date has no exposures.\n"; + } + next; + } + else { + do_extra_processing($date,$target,$filter,$pretend); + } + + } + if ($stackable_list{$target} == 1) { + my ($Nexposures,$NprocChips,$NprocWarps,$Nalready) = pre_stack_queue($date,$target,$filter); + if ((!defined($force_stack_count))&&($NprocChips != $NprocWarps)) { # This makes me sad. :( + if ($debug == 1) { + print STDERR "execute_stacks: Target $target on $date is not fully processed. ($NprocChips $NprocWarps)\n"; + } + $metadata_out{nsState} = 'FORCETOWARP'; + next; + } + if ($Nexposures == 0) { + if ($debug == 1) { + print STDERR "execute_stacks: Target $target in filter $filter on $date has no exposures.\n"; + } + next; + } + if ($Nalready != 0) { + if ($debug == 1) { + print STDERR "execute_stacks: Not queueing $target in filter $filter on $date due to already existing stacks.\n"; + } + unless ($metadata_out{nsState} eq 'FORCETOWARP') { + $metadata_out{nsState} = 'STACKING'; + } + next; + } + unless (($metadata_out{nsState} eq 'FORCETOWARP')||($metadata_out{nsState} eq 'STACKING')) { + $metadata_out{nsState} = 'QUEUESTACKS'; + } + unless(defined($pretend)) { + if ($debug == 1) { + print STDERR "execute_stacks: Target $target in filter $filter on $date has exposures and will be queued.\n"; + } + stack_queue($date,$target,$filter); + } + if (defined($pretend)) { + add_to_macro_list('check_stacks',$stackable_list{$target},$date,$target,$filter); + } + else { + add_to_macro_list('queue_stacks',$stackable_list{$target},$date,$target,$filter); + } + } + else { + # print STDERR "execute_stacks: Target $target is not auto-stackable.\n"; + } + } + } +} + +sub post_stack_queue { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + # check warp stage == chip stage + my $db = init_gpc_db(); + + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $where = " label = '$label' AND data_group = '$data_group' "; + + my $stack_full_sth = "SELECT * from stackRun where $where "; + my $stack_done_sth = "SELECT * from stackRun LEFT JOIN stackSumSkyfile USING(stack_id) WHERE $where "; + $stack_done_sth .= " AND ((state = 'full') OR (state = 'new' && fault != 0)) "; + if ($debug == 1) { + print STDERR "post_stack_queue: database queries:\n"; + print STDERR "$stack_full_sth\n"; + print STDERR "$stack_done_sth\n"; + } + my $stack_full_ref = $db->selectall_arrayref( $stack_full_sth ); + my $stack_done_ref = $db->selectall_arrayref( $stack_done_sth ); + + return($#{ $stack_full_ref } + 1, $#{ $stack_done_ref } + 1); +} + +sub confirm_stacks { + my $date = shift; + my $pretend = shift; + + foreach my $target (@target_list) { + if ($stackable_list{$target} == 1) { + my ($Nstacks, $Nattempted) = post_stack_queue($date,$target); + if ($debug == 1) { + print STDERR "confirm_stacks: Target $target on $date has $Nattempted attempts on $Nstacks.\n"; + } + if ($Nstacks != $Nattempted) { + if ($debug == 1) { + print STDERR "confirm_stacks: Target $target on $date is not done stacking. $Nstacks $Nattempted\n"; + } + if ($metadata_out{nsState} eq 'CONFIRM_STACKING') { + $metadata_out{nsState} = 'STACKING'; + } + next; + } + if ($Nstacks == 0) { + if ($debug == 1) { + print STDERR "confirm_stacks: Target $target on $date has no stacks. Skipping.\n"; + } + next; + } + if ($metadata_out{nsState} eq 'CONFIRM_STACKING') { + if (defined($pretend)) { + add_to_macro_list('check_confirm_stacks',$stackable_list{$target},$date,$target); + } + else { + add_to_macro_list('confirm_stacks',$stackable_list{$target},$date,$target); + } + } + } + } +} + +# +# Extra processing +################################################################################ + +sub verify_uniqueness_diff { + my $warp_id_1 = shift; + my $warp_id_2 = shift; + my $date = shift; + my $target = shift; + + my $db = init_gpc_db(); + $date =~ s/-//g; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $sth = "SELECT diff_id from diffRun JOIN diffInputSkyfile USING(diff_id) where data_group = '$data_group' AND warp1 = $warp_id_1 AND warp2 = $warp_id_2"; + my $data_ref = $db->selectall_arrayref( $sth ); + + return($#{ $data_ref } + 1); +} + +sub do_extra_processing { + my $date = shift; + my $target = shift; + my $filter = shift; + my $pretend = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + if (($target eq 'OSS')||($target eq 'SweetSpot')) { + my $db = init_gpc_db(); + + my $obj_sth = "select DISTINCT rawExp.object from warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) "; + $obj_sth .= " WHERE warpRun.state = 'full' AND warpRun.label = '$label' AND warpRun.data_group = '$data_group' AND rawExp.filter = '$filter' ORDER BY rawExp.object"; + print STDERR "$obj_sth\n"; + my $object_ref = $db->selectall_arrayref( $obj_sth ); + + foreach my $object_row (@{ $object_ref }) { + my $this_object = shift @{ $object_row }; + my $input_sth = "select exp_id,warp_id,dateobs from warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) "; + $input_sth .= " WHERE warpRun.state = 'full' AND warpRun.label = '$label' AND warpRun.data_group = '$data_group' AND rawExp.filter = '$filter' AND rawExp.object = '$this_object' "; + $input_sth .= " ORDER BY dateobs "; + + my $warps = $db->selectall_arrayref( $input_sth ); + + if (($#{ $warps } + 1) % 2 != 0) { + print STDERR "Number of input warps to make OSS diffs is not even! $this_object $#{ $warps }\n"; +# last; + next; + } + + while ($#{ $warps } > -1) { + my $input_warp = shift @{ $warps }; + my $template_warp = shift @{ $warps }; + my $input_exp_id = ${ $input_warp }[0]; + my $template_exp_id = ${ $template_warp }[0]; + + my $input_warp_id = ${ $input_warp }[1]; + my $template_warp_id = ${ $template_warp }[1]; + + if (verify_uniqueness_diff($input_warp_id,$template_warp_id,$date,$target) != 0) { + print STDERR "Diffs already queued for this $date $target $input_exp_id $template_exp_id\n"; + next; + } + + my $cmd = "$difftool -dbname $dbname -definewarpwarp "; + $cmd .= "-input_label $label -template_label $label "; + $cmd .= "-backwards "; # Needed because difftool assumes a different date sorting. + $cmd .= "-set_workdir $workdir -set_dist_group $dist_group -set_data_group $data_group "; + $cmd .= " -simple -set_label $label -exp_id $input_exp_id -template_exp_id $template_exp_id "; +# $cmd .= " -pretend "; + if (defined($pretend)) { + $cmd .= ' -pretend '; + } + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "EXTRA_PROCESSING: $cmd\n"; + if (($debug == 0)&&(!defined($pretend))) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $cmd, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + } + } + } + } +} + + + + +# +# Auto-Clean +################################################################################ + +sub construct_cleantool_args { + my $date = shift; + my $target = shift; + my $mode = shift; + + my $command = $clean_commands{$mode}; + my $retention_time; + if (exists($cleanmods_list{$target}{$mode})) { + $retention_time = $cleanmods_list{$target}{$mode}; + } + else { + $retention_time = $clean_retention{$mode}; + } + if ($retention_time <= 0) { + return("no clean","true"); + } + + my ($year,$month,$day) = split /-/,$date; + my $dt = DateTime->new(year => $year, month => $month, day => $day, + hour => 0, minute => 0, second => 0, nanosecond => 0, + time_zone => 'Pacific/Honolulu'); + + $dt->subtract(days => $retention_time); + my $cleaning_date = $dt->ymd; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($cleaning_date,$target); + my $args = $command; + if ((exists($clean_alternate{$mode})) && ($clean_alternate{$mode} eq 'A')) { + $args .= " -dbname $dbname -updaterun -set_state goto_cleaned -full -set_label goto_cleaned -label $label -time_stamp_end $cleaning_date "; + } + elsif ((exists($clean_alternate{$mode})) && ($clean_alternate{$mode} eq 'B')) { + $args .= " -dbname $dbname -updaterun -set_state goto_cleaned -state full -set_label goto_cleaned -label $label "; + } + else { + $args .= " -dbname $dbname -updaterun -set_state goto_cleaned -state full -set_label goto_cleaned -label $label -data_group $data_group "; + } + if ($debug == 1) { + $args .= ' -pretend '; + } + return($cleaning_date,$args); +} + +sub execute_cleans { + my $date = shift; + my $pretend = shift; + + foreach my $mode (@mode_list) { + foreach my $target (@target_list) { + if (exists($noclean_list{$target})) { + next; + } + my ($cleaning_date,$command) = construct_cleantool_args($date,$target,$mode); + if ($cleaning_date eq 'no clean') { + next; + } + print STDERR "$command\n"; + if (!(defined($pretend) || $debug == 1)) { +# print STDERR "BEAR IS DRIVING!?\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform cleantool ($command): $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + add_to_macro_list('clean_old',1,$date,$target,$mode); + } + } + } + return(0); +} + +# +# Utilities +################################################################################ + +sub get_tool_parameters { + my $date = shift; + my $target = shift; + my $workdir_date = $date; $workdir_date =~ s%-%/%g; + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $label = "${target}.nightlyscience"; + my $workdir = "neb://\@HOST\@.0/${dbname}/${target}.nt/${workdir_date}"; + my $obs_mode = $obsmode_list{$target}; + my $object = $object_list{$target}; + my $comment = $comment_list{$target}; + my $dist_group = $distribution_list{$target}; + my $data_group = "${target}.${trunc_date}"; + my $tess_id = $tessID_list{$target}; + my $reduction = $reduction_class{$target}; + return($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction); +} + +sub get_dettool_parameters { + my $date = shift; + my $target = shift; + my $workdir_date = $date; $workdir_date =~ s%-%/%g; + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $exp_type = $exptype_list{$target}; + my $det_type = $dettype_list{$target}; + my $ref_det_id = $refID_list{$target}; + my $ref_iter = $refIter_list{$target}; + my $det_filter = $detfilter_list{$target}; + my $internal_filter; + if (defined($det_filter)) { + $internal_filter = $det_filter; $internal_filter =~ s/\..*//; + $internal_filter = '.' . $internal_filter; + } + else { + $internal_filter = ''; + } + my $maxN = $detmax_list{$target}; + + my $lc_type = lc($exp_type); + my $label = "${lc_type}${internal_filter}.$trunc_date"; + my $workdir = 'neb://@HOST@.0/' . $dbname . "/detverify.nt/${workdir_date}/${lc_type}${internal_filter}"; + return($label,$workdir,$det_filter,$exp_type,$det_type,$ref_det_id,$ref_iter,$maxN); +} + +sub add_to_macro_list { + my $proc_mode = shift; + my $do_or_do_not = shift; + my $date = shift; + my $target = shift; + my $mode = shift; + + if ((defined($macro_formats{$proc_mode}))&&($do_or_do_not)) { + unless (defined($metadata_out{N_MACROS})) { + $metadata_out{N_MACROS} = 0; + } + my $N = $metadata_out{N_MACROS}; + $metadata_out{"ns${N}Macro"} = $macro_formats{$proc_mode}; + if ($debug == 1) { + print STDERR "WORKING ON A MACRO: ns${N}Macro $proc_mode $macro_formats{$proc_mode}\n"; + } + if (defined($date)&&(defined($target))) { + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) + = get_tool_parameters($date,$target); + $metadata_out{"ns${N}Macro"} =~ s/\@LABEL\@/$label/; + $metadata_out{"ns${N}Macro"} =~ s/\@WORKDIR\@/$workdir/; + $metadata_out{"ns${N}Macro"} =~ s/\@OBS_MODE\@/$obs_mode/; + $metadata_out{"ns${N}Macro"} =~ s/\@OBJECT\@/$object/; + $metadata_out{"ns${N}Macro"} =~ s/\@COMMENT\@/$comment/; + $metadata_out{"ns${N}Macro"} =~ s/\@TESS_ID\@/$tess_id/; + $metadata_out{"ns${N}Macro"} =~ s/\@DIST_GROUP\@/$dist_group/; + $metadata_out{"ns${N}Macro"} =~ s/\@DATA_GROUP\@/$data_group/; + $metadata_out{"ns${N}Macro"} =~ s/\@REDUCTION\@/$reduction/; + } + if (defined($mode)) { + $metadata_out{"ns${N}Macro"} =~ s/\@EXTRA\@/$mode/; + } + if (defined($date)) { + $metadata_out{"ns${N}Macro"} =~ s/\@DATE\@/$date/; + } + if ($debug == 1) { + print STDERR "DONE WITH A MACRO: ns${N}Macro $proc_mode $macro_formats{$proc_mode}\n"; + } + $metadata_out{N_MACROS} ++; + } +} + +sub init_gpc_db { + ## change to use the site.config setting now, however may want to use replicated scidbs instead + my $ipprc = PS::IPP::Config->new(); # IPP Configuration + my $siteConfig = $ipprc->{_siteConfig}; + use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock'; + # my $dbserver = 'ippdb01'; + my $dbuser = 'ippuser'; + my $dbpass = 'ippuser'; + my $dbserver = metadataLookupStr($siteConfig, 'DBSERVER'); + die "database configuration set up" unless defined($dbserver); + $db = DBI->connect("DBI:mysql:database=${dbname};host=${dbserver};" . + "mysql_socket=" . DB_SOCKET(), + ${dbuser},${dbpass}, + { RaiseError => 1, AutoCommit => 1} + ) or die "Unable to connect to database $DBI::errstr\n"; + return($db); +} + +sub return_metadata { + my $date = shift; + print STDOUT "autoStack MULTI\n\n"; + print STDOUT "autoStack METADATA\n"; + print STDOUT " date STR $date\n"; + foreach my $k (sort(keys %metadata_out)) { + print STDOUT " $k STR $metadata_out{$k}\n"; + } + print STDOUT "END\n"; +} + +sub my_die { + my $msg = shift; # Warning message on die + my $stage = shift; # stage name + my $stage_id = shift; # identifier + my $exit_code = shift; # Exit code + # outputImage and path_base are globals + + carp($msg); + exit $exit_code; +} + +sub my_trace { + if ($debug == 1) { + foreach my $thing (@_) { + carp($thing); + } + } +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/background_chip.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/background_chip.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/background_chip.pl (revision 41105) @@ -0,0 +1,327 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script +use File::Basename; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $bgtool = can_run('bgtool') or (warn "Can't find bgtool" and $missing_tools = 1); +my $ppBackground = can_run('ppBackground') or (warn "Can't find ppBackground" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my @ARGS = @ARGV; + +# Parse the command-line arguments +my ( $chip_bg_id, $class_id, $camera, $outroot, $dbname, $reduction, $verbose, + $threads, $no_update, $save_temps, $no_op, $redirect, $chip_path_base, $cam_path_base, $magicked ); +GetOptions( + 'chip_bg_id=s' => \$chip_bg_id, # chipBackgroundRun identifier + 'class_id=s' => \$class_id, # Class identifier + 'camera|c=s' => \$camera, # Camera + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'threads=s' => \$threads, # Number of threads to use + 'chip_path_base=s' => \$chip_path_base, # optional chip_path_base + 'cam_path_base=s' => \$cam_path_base, # optional camera stage path_base + 'magicked=s' => \$magicked, # magicked status of input + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --chip_bg_id --class_id --camera --outroot", + -exitval => 3) unless + defined $chip_bg_id and + defined $class_id and + defined $camera and + defined $outroot; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $chip_bg_id, $class_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.IMFILE", $outroot, $class_id) or &my_die("Missing entry from camera config", $chip_bg_id, $class_id, $PS_EXIT_CONFIG_ERROR); + +if ($redirect) { + $ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR ); + print STDOUT "\n\n"; + print STDOUT "Starting script $0 on $host\n\n"; + print STDOUT "FULL COMMAND: $0 @ARGS\n\n"; +} + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_ppBackground = $ipprc->reduction($reduction, 'BACKGROUND_PPBACKGROUND'); # ppBackground recipe +unless ($recipe_ppBackground) { + &my_die("Couldn't find selected reduction for BACKGROUND_PPBACKGROUND: $reduction\n", $chip_bg_id, $class_id, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Get inputs +my $in_path; # Input path +my $do_stats; +my $dump_config; +if ($chip_path_base and $no_update) { + # XXX: this path through the code has not been excercized in awhile and probably does not work + + # we are running outside of a chip_bg_run (perhaps by the postage stamp server) don't dump config + # or do stats. Get path to input from command line. + $in_path = $chip_path_base; + $magicked = 0 if !defined $magicked; + $do_stats = 0; + $dump_config = 0; +} else { + # normal operation. Get input parameters from the database + $do_stats = 1; + $dump_config = 1; + my $command = "bgtool -chipinputs -chip_bg_id $chip_bg_id -class_id $class_id"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to get inputs: $error_code\n"); + exit($error_code); + } + + my $inputs = $mdcParser->parse_list(join "", @$stdout_buf) or &my_die("Unable to parse metadata config doc", $chip_bg_id, $class_id, $PS_EXIT_PROG_ERROR); + &my_die("Input list does not contain exactly one entry", $chip_bg_id, $class_id, $PS_EXIT_PROG_ERROR) unless scalar @$inputs == 1; + my $input = $$inputs[0]; # Input of interest + $in_path = $input->{path_base}; + $cam_path_base = $input->{cam_path_base}; + $magicked = $input->{magicked}; +} + +my $in_image = $ipprc->filename("PPIMAGE.CHIP", $in_path, $class_id); +my $in_mask; +if ($cam_path_base) { + $in_mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $cam_path_base, $class_id); +} else { + $in_mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $in_path, $class_id); +} +my $in_wt = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $in_path, $class_id); +my $in_bg; +if (1) { + $in_bg = $ipprc->filename("PPIMAGE.BACKMDL", $cam_path_base, $class_id); +} +else { + $in_bg = $ipprc->filename("PSPHOT.BACKMDL", $in_path, $class_id); +} +my $in_pattern = $ipprc->filename("PPIMAGE.PATTERN", $in_path, $class_id); +my $in_config = $ipprc->filename("PPIMAGE.CONFIG", $in_path, $class_id); + +# Determine what to apply +my ($apply_bg, $apply_pattern); # Apply the background and pattern? +{ + &my_die("Cannot find input file: $in_config", $chip_bg_id, $class_id, $PS_EXIT_PROG_ERROR) unless $ipprc->file_exists($in_config); + + my $command = "$ppConfigDump -ipprc $in_config -dump-recipe PPIMAGE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR); + } + my $recipe = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR); + + $apply_bg = metadataLookupBool($recipe, "BACKGROUND"); + my $row = metadataLookupBool($recipe, "PATTERN.ROW"); + my $cell = metadataLookupBool($recipe, "PATTERN.CELL"); + $apply_pattern = ($row or $cell); +} + +# Set up files +&my_die("Couldn't find input file: $in_image\n", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($in_image); +&my_die("Couldn't find input file: $in_mask\n", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($in_mask); +&my_die("Couldn't find input file: $in_wt\n", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($in_wt); +&my_die("Couldn't find input file: $in_bg\n", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($in_bg) or !$apply_bg; +&my_die("Couldn't find input file: $in_pattern\n", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($in_pattern) or !$apply_pattern; + +$ipprc->outroot_prepare($outroot); + +my $out_image = prepare_output("PPBACKGROUND.OUTPUT", $outroot, $class_id, 1); +my $out_mask = prepare_output("PPBACKGROUND.OUTPUT.MASK", $outroot, $class_id, 1); +my $out_wt = prepare_output("PPBACKGROUND.OUTPUT.VARIANCE", $outroot, $class_id, 1); +my $out_stats = prepare_output("PPBACKGROUND.STATS", $outroot, $class_id, 1); +my $out_config = prepare_output("PPBACKGROUND.CONFIG", $outroot, $class_id, 1); +my $traceDest = prepare_output("TRACE.IMFILE", $outroot, $class_id, 1); + + +# Run ppBackground +unless ($no_op) { + my $command = "$ppBackground $outroot"; + $command .= " -image $in_image"; + $command .= " -mask $in_mask"; + $command .= " -variance $in_wt"; + $command .= " -stats $out_stats" if $do_stats; + $command .= " -background $in_bg" if $apply_bg; + $command .= " -pattern $in_pattern" if $apply_pattern; + $command .= " -recipe PPBACKGROUND $recipe_ppBackground"; + $command .= " -recipe PPSTATS CHIPSTATS" if $do_stats; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " -dumpconfig $out_config" if $dump_config; + $command .= " -tracedest $traceDest -log $logDest"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppBackground: $error_code", $chip_bg_id, $class_id, $error_code); + } +} + +# Gather command-line arguments from statistics +my $cmdflags = ""; # Command-line flags to add +my $quality = 0; # Quality flag +if ($do_stats) { + &my_die("Couldn't find expected output file: $out_stats", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_stats); + + my $resolved_stats = $ipprc->file_resolve($out_stats); + my $command = "$ppStatsFromMetadata $resolved_stats - BACKGROUND_CHIP"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $chip_bg_id, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag +} + +my $do_binned_images = 1; # Generate the binned images that are useful for making JPEGs +if ($do_binned_images) { + my $command = "$ppImage -file $out_image -mask $out_mask $outroot -recipe PPIMAGE PPIMAGE_PA -Db PHOTOM F"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $chip_bg_id, $class_id, $error_code); + } +} + + +if (!$quality and !$no_op) { + &my_die("Couldn't find expected output file: $out_image", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_image); + &my_die("Couldn't find expected output file: $out_mask", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_mask); + &my_die("Couldn't find expected output file: $out_config", $chip_bg_id, $class_id, $PS_EXIT_SYS_ERROR) unless !$dump_config or $ipprc->file_exists($out_config); + +} + +# Update database +{ + my $command = "$bgtool -addchip"; + $command .= " -chip_bg_id $chip_bg_id"; + $command .= " -class_id $class_id"; + $command .= " -path_base $outroot"; + $command .= " -set_magicked $magicked" if $magicked; + $command .= " -hostname $host" if defined $host; + $command .= " $cmdflags"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform chiptool -addprocessedimfile: $error_code\n"); + exit($error_code); + } + } else { + print "skipping command: $command\n"; + } +} + + +### Pau. + +# Prepare to write to an output file +# Lookup the filename in the rules. +# Make sure that if file exists and is a nebulous file that there is only one instance +# Deal with files that have been lost. +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $class_id = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, $class_id, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $chip_bg_id, $class_id, $error); + return $output; +} + + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $chip_bg_id = shift; # Chiptool identifier + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $chip_bg_id and defined $class_id and not $no_update) { + my $command = "$bgtool -addchip"; + $command .= " -chip_bg_id $chip_bg_id"; + $command .= " -class_id $class_id"; + $command .= " -fault $exit_code"; + $command .= " -path_base $outroot"; + $command .= " -hostname $host" if defined $host; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -dbname $dbname" if defined $dbname; + system($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/background_warp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/background_warp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/background_warp.pl (revision 41105) @@ -0,0 +1,308 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use File::Temp qw( tempfile ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +# Look for programs we need +my $missing_tools; +my $bgtool = can_run('bgtool') or (warn "Can't find bgtool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $pswarp = can_run('pswarp') or (warn "Can't find pswarp" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($warp_bg_id, $skycell_id, $tess_dir, $reduction, $camera, $dbname, $outroot, $threads, $verbose, $no_update, $no_op, $redirect, $save_temps); +my ($astrometry, $imageName, $maskName, $weightName, $magicked); +GetOptions( + 'warp_bg_id|i=s' => \$warp_bg_id, # Warp identifier + 'skycell_id|s=s' => \$skycell_id, # Skycell identifier + 'tess_dir|s=s' => \$tess_dir, # Tesselation identifier + 'camera|c=s' => \$camera, # Camera name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'outroot=s' => \$outroot, # Output root name + 'image-list=s' => \$imageName, # list of input image files + 'mask-list=s' => \$maskName, # list of input mask files + 'astrometry=s' => \$astrometry, + 'magicked=s' => \$magicked, + 'threads=s' => \$threads, # Number of threads to use for pswarp + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --warp_bg_id --skycell_id --tess_dir --camera --outroot", + -exitval => 3, +) unless defined $warp_bg_id + and defined $skycell_id + and defined $tess_dir + and defined $camera + and defined $outroot; + +if ($imageName) { + # we have been invoked in a special mode where the caller tells us all about the inputs + # This is used by the postage stamp server to make non-background corrected images without + # the existence of a warpBackgroundRun (or chipBackgroundRun) + # Make sure all of the inputs were supplied + if (!(defined $maskName and defined $astrometry and defined $magicked)) { + print STDERR "mask-list, astrometry, and magicked must be supplied if image-list is used\n"; + if ($warp_bg_id) { + my_die( "invalid argument list.", $warp_bg_id, $skycell_id, $PS_EXIT_CONFIG_ERROR ); + } + exit $PS_EXIT_CONFIG_ERROR; + } +} + +my $ipprc = PS::IPP::Config->new( $camera ) or +my_die( "Unable to set up", $warp_bg_id, $skycell_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot, $skycell_id) or my_die( "Unable to get log filename", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR ); + +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_pswarp = $ipprc->reduction($reduction, 'BACKGROUND_PSWARP'); # Recipe to use +my $recipe_psastro = $ipprc->reduction($reduction, 'PSASTRO'); # Recipe to use +unless ($recipe_pswarp and $recipe_psastro) { + &my_die("Couldn't find selected reduction: $reduction\n", $warp_bg_id, $skycell_id, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Where do we get the astrometry source from? +my $astromSource; # The astrometry source +{ + my $command = "$ppConfigDump -camera $camera -recipe PSWARP $recipe_pswarp -dump-recipe PSWARP -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $warp_bg_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $warp_bg_id, $PS_EXIT_PROG_ERROR); + $astromSource = metadataLookupStr($metadata, 'ASTROM.SOURCE'); +} + +# Get list of filenames +my $tempOutRoot = "/tmp/background.warp.$warp_bg_id.$skycell_id"; + +if (!defined $imageName) { + # go find our inputs + my ($imageFile, $maskFile, $weightFile); + ($imageFile, $imageName) = tempfile( "$tempOutRoot.image.list.XXXX", UNLINK => !$save_temps); + ($maskFile, $maskName) = tempfile( "$tempOutRoot.mask.list.XXXX", UNLINK => !$save_temps); + ($weightFile, $weightName) = tempfile( "$tempOutRoot.wt.list.XXXX", UNLINK => !$save_temps); + my $command = "$bgtool -warpinputs"; + $command .= " -warp_bg_id $warp_bg_id"; + $command .= " -skycell_id $skycell_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to get input list: $error_code", $warp_bg_id, $skycell_id, $error_code); + } + + my $files = $mdcParser->parse_list(join "", @$stdout_buf) or &my_die("Unable to parse metadata config doc", $warp_bg_id, $skycell_id, $PS_EXIT_PROG_ERROR); + foreach my $file (@$files) { + my $chip_path = $file->{chip_path_base}; + my $class_id = $file->{class_id}; + my $image = $ipprc->filename("PPBACKGROUND.OUTPUT", $chip_path, $class_id); + my $mask = $ipprc->filename("PPBACKGROUND.OUTPUT.MASK", $chip_path, $class_id ); + my $wt = $ipprc->filename("PPBACKGROUND.OUTPUT.VARIANCE", $chip_path, $class_id ); + print $imageFile "$image\n"; + print $maskFile "$mask\n"; + print $weightFile "$wt\n"; + &my_die("Can't find input image: $image", $warp_bg_id, $skycell_id, $PS_EXIT_PROG_ERROR) unless $ipprc->file_exists($image); + &my_die("Can't find input mask: $mask", $warp_bg_id, $skycell_id, $PS_EXIT_PROG_ERROR) unless $ipprc->file_exists($mask); + &my_die("Can't find input mask: $wt", $warp_bg_id, $skycell_id, $PS_EXIT_PROG_ERROR) unless $ipprc->file_exists($wt); + + &my_die("Magic status don't match: $magicked vs $file->{magicked}", $warp_bg_id, $skycell_id, $PS_EXIT_PROG_ERROR) if defined $magicked and $magicked != $file->{magicked}; + $magicked = $file->{magicked}; + + my $cam_path = $file->{cam_path_base}; + my $astrom = $ipprc->filename($astromSource, $cam_path); + &my_die("Astrometry files don't match: $astrom vs $astrometry", $warp_bg_id, $skycell_id, $PS_EXIT_PROG_ERROR) if defined $astrometry and $astrom ne $astrometry; + $astrometry = $astrom; + } + close $imageFile; + close $maskFile; + close $weightFile; +} + +&my_die("Can't find input astrometry: $astrometry", $warp_bg_id, $skycell_id, $PS_EXIT_PROG_ERROR) unless $ipprc->file_exists($astrometry); + +#my $out_image = $ipprc->filename("PSWARP.OUTPUT", $outroot, $skycell_id ); +#my $out_mask = $ipprc->filename("PSWARP.OUTPUT.MASK", $outroot, $skycell_id); +#my $out_stats = $ipprc->filename("SKYCELL.STATS", $outroot, $skycell_id ); +#my $out_config = $ipprc->filename("PSWARP.CONFIG", $outroot, $skycell_id); +#my $traceDest = $ipprc->filename("TRACE.EXP", $outroot, $skycell_id); + +my $out_image = prepare_output("PSWARP.OUTPUT", $outroot, $skycell_id, 1); +my $out_mask = prepare_output("PSWARP.OUTPUT.MASK", $outroot, $skycell_id, 1); +my $out_wt = prepare_output("PSWARP.OUTPUT.VARIANCE", $outroot, $skycell_id, 1); +my $out_stats = prepare_output("SKYCELL.STATS", $outroot, $skycell_id, 1); +my $out_config = prepare_output("PSWARP.CONFIG", $outroot, $skycell_id, 1); +my $traceDest = prepare_output("TRACE.EXP", $outroot, $skycell_id, 1); + +my $skyFile = prepare_output("SKYCELL.TEMPLATE", $outroot, $skycell_id, 1); + +$ipprc->skycell_file( $tess_dir, $skycell_id, $skyFile, $verbose ) or &my_die("Unable to generate template skycell", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR); + +# Run pswarp +unless ($no_op) { + my $command = "$pswarp"; + $command .= " -list $imageName"; + $command .= " -masklist $maskName"; + $command .= " -variancelist $weightName"; + $command .= " -astrom $astrometry"; + $command .= " $outroot $skyFile"; + $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + # XXX: change fits type based on recipe + $command .= " -R PSWARP.OUTPUT FITS.TYPE NONE"; + $command .= " -recipe PSWARP $recipe_pswarp"; + $command .= " -recipe PPSTATS WARPSTATS"; + $command .= " -stats $out_stats"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -threads $threads" if defined $threads; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " -dumpconfig $out_config"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform pswarp: $error_code", $warp_bg_id, $skycell_id, $error_code); + } +} + +# Read the statistics +my $cmdflags; +{ + &my_die("Couldn't find expected output file: $out_stats", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_stats); + + my $real_stats = $ipprc->file_resolve($out_stats); + + my $command = "$ppStatsFromMetadata $real_stats - BACKGROUND_WARP"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + my ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + + if (!$quality) { + &my_die("Couldn't find expected output file: $out_image", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_image); + &my_die("Couldn't find expected output file: $out_mask", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_mask); + &my_die("Couldn't find expected output file: $out_wt", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_wt); + &my_die("Couldn't find expected output file: $out_config", $warp_bg_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($out_config); + } +} + +unless ($no_update) { + my $command = "$bgtool -addwarp"; + $command .= " -warp_bg_id $warp_bg_id"; + $command .= " -skycell_id $skycell_id"; + $command .= " -path_base $outroot"; # needed for logfile lookups + $command .= " -set_magicked $magicked" if $magicked; + $command .= " -hostname $host"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " $cmdflags"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to update database: $error_code\n"); + exit($error_code); + } +} + +### Pau. + +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $skycell_id = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, $skycell_id, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $warp_bg_id, $skycell_id, $error); + return $output; +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $warp_bg_id = shift; # warpBackgroundRun identifier + my $skycell_id = shift; # Skycell identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $warp_bg_id and defined $skycell_id and not $no_update) { + my $command = "$bgtool -addwarp"; + $command .= " -warp_bg_id $warp_bg_id"; + $command .= " -skycell_id $skycell_id"; + $command .= " -path_base $outroot"; + $command .= " -hostname $host" if defined $host; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + run(command => $command, verbose => $verbose); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/bundle_detrends.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/bundle_detrends.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/bundle_detrends.pl (revision 41105) @@ -0,0 +1,146 @@ +#! /usr/bin/env perl + +use Carp; + +use warnings; +use strict; +use DBI; +use IPC::Cmd 0.36 qw( can_run run); +use File::Temp qw( tempfile ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +my $missing_tools = 0; +my $tar = can_run('tar') or (warn "Can't find tar" and $missing_tools = 1); + +my $db; + +my ($det_id, $outfile, $dbname, $verbose, $save_temps); + +GetOptions( + 'det_id=s' => \$det_id, + 'outfile=s' => \$outfile, + 'dbname=s' => \$outfile, + 'verbose' => \$verbose, + 'save_temps' => \$save_temps, + ) or pod2usage ( 2 ); +pod2usage( -msg => +"USAGE: bundle_detrends.pl + Options: + --det_id det_id to bundle + --outfile specify and output name + --dbname Default gpc1. + --verbose\n", + -exitval => 2, ) if @ARGV; + +unless(defined($dbname)) { + $dbname = 'gpc1'; +} +unless(defined($outfile)) { + $outfile = "./detrend_${det_id}.tgz"; +} +my $ipprc = PS::IPP::Config->new( ) or my_die( "Unable to set up", $det_id, $outfile); + +# Create database information +$db = init_gpc_db(); + +my ($dbFile, $dbName) = tempfile("/tmp/bundle_detrend.tmp.XXXX", UNLINK => !$save_temps); +my @tables = ('detInputExp','detNormalizedExp','detNormalizedImfile','detNormalizedStatImfile','detProcessedExp', + 'detProcessedImfile','detRegisteredImfile','detResidExp','detResidImfile','detRun','detRunSummary', + 'detStackedImfile'); + +foreach my $t (@tables) { + print $dbFile "-- $t\n"; +# print STDERR "-- $t\n"; + my $sth = "select * from $t WHERE det_id = $det_id"; +# my $dr = $db->selectall_arrayref( $sth ); + my $prep = $db->prepare($sth); + + my $ex = $prep->execute() or die "Execute execption: $DBI::errstr"; + my $colstring = join ',', @{ $prep->{NAME} }; + my @types = @{ $prep->{TYPE} }; + my $dr = $prep->fetchall_arrayref(); + foreach my $rr (@{ $dr }) { + for (my $i = 0; $i <= $#{ $rr }; $i++) { + ${ $rr }[$i] = $db->quote(${ $rr }[$i], $types[$i]); + } + my $valstring = join ',', @{ $rr }; + print $dbFile "INSERT INTO $t ($colstring) VALUES($valstring);\n"; +# print STDERR "INSERT INTO $t ($colstring) VALUES($valstring);\n"; + } + print $dbFile "\n"; + $prep->finish(); +} + +# Create tar file + +# Identify files +my @neb_files = (); +# Do we have any registered imfiles for this det_id? +if ($#neb_files == -1) { + my $sth = "select uri from detRegisteredImfile where det_id = $det_id"; + my $dr = $db->selectall_arrayref( $sth ); + foreach my $rr (@{ $dr }) { + push @neb_files, @{ $rr }; + } +} +# Try the normalized imfiles +if ($#neb_files == -1) { + my $sth = "select uri from detNormalizedImfile where det_id = $det_id"; + my $dr = $db->selectall_arrayref( $sth ); + foreach my $rr (@{ $dr }) { + push @neb_files, @{ $rr }; + } +} +# Try the stacked imfiles if we have to +if ($#neb_files == -1) { + my $sth = "select uri from detStackedImfile where det_id = $det_id"; + my $dr = $db->selectall_arrayref( $sth ); + foreach my $rr (@{ $dr }) { + push @neb_files, @{ $rr }; + } +} + +my @disk_files = map { $_ = $ipprc->file_resolve( $_ ) } @neb_files; + +my $cmd_files = join ' ', @disk_files; +my $tar_cmd = "tar -zvcf $outfile --transform='s/\.tmp\...../.sql/;s/tmp/./;s/.*://;' --strip-components=5 --show-transformed-names $dbName $cmd_files"; + +print "$tar_cmd\n"; +my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $tar_cmd, verbose => $verbose); +unless ($success) { + &my_die("Unable to perform tar: $error_code", $det_id, $outfile); +} + +# Utilities + +sub my_die { + my $message = shift; + my $det_id = shift; + my $out = shift; + + carp($message); + exit(1); +} + +sub init_gpc_db { + ## change to use the site.config setting now, however may want to use replicated scidbs instead + my $siteConfig = $ipprc->{_siteConfig}; + use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock'; + # my $dbserver = 'ippdb01'; + my $dbuser = 'ippuser'; + my $dbpass = 'ippuser'; + my $dbserver = metadataLookupStr($siteConfig, 'DBSERVER'); + die "database configuration set up" unless defined($dbserver); + $db = DBI->connect("DBI:mysql:database=${dbname};host=${dbserver};" . + "mysql_socket=" . DB_SOCKET(), + ${dbuser},${dbpass}, + { RaiseError => 1, AutoCommit => 1} + ) or die "Unable to connect to database $DBI::errstr\n"; + return($db); +} + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/calibrate_dvo.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/calibrate_dvo.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/calibrate_dvo.pl (revision 41105) @@ -0,0 +1,196 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Storable qw(freeze thaw); +use File::Basename qw( basename); +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration +use File::Spec; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($cal_id, $dvodb, $region, $dbname, $workdir, $no_update, $no_op); +GetOptions( + 'cal_id|i=s' => \$cal_id, + 'dvodb|c=s' => \$dvodb, + 'region|r=s' => \$region, + 'dbname|d=s' => \$dbname,# Database name + 'workdir|w=s' => \$workdir, # Working directory for output files + 'no-update' => \$no_update, + 'no-op' => \$no_op, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --cal_id --dvodb --region", + -exitval => 3) unless + defined $cal_id and + defined $dvodb and + defined $region; + +# Look for programs we need +my $missing_tools; +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); +my $relphot = can_run('relphot') or (warn "Can't find relphot" and $missing_tools = 1); +my $uniphot = can_run('uniphot') or (warn "Can't find uniphot" and $missing_tools = 1); +my $relastro = can_run('relastro') or (warn "Can't find relastro" and $missing_tools = 1); +my $caltool = can_run('caltool') or (warn "Can't find caltool" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + +# select the primary filters from DVO query? +my (@filters) = `photcodeList -average`; + +# parse the region (RAs,RAe:DECs,DECe) : item = +/-NNN.NNNN +my @coords = split (":", $region); +my ($RAs, $RAe) = split (",", $coords[0]); +my ($DECs, $DECe) = split (",", $coords[1]); + +# Run addstar -resort +{ + my $command = "$addstar -resort"; + $command .= "-D CATDIR $dvodb"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $cal_id, $region, "RESORT", $status, $dbname); + } +} + +# Run relphot (filter) for each filter +{ + foreach my $filter (@filters) { + my $command = "$relphot $filter"; + $command .= "-D CATDIR $dvodb"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $cal_id, $region, "RELPHOT", $status, $dbname); + } + } +} + +# Run uniphot (filter) for each filter +# XXX skip this one? run less frequently? +if (0) { + foreach my $filter (@filters) { + my $command = "$uniphot $filter"; + $command .= "-D CATDIR $dvodb"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $cal_id, $region, "UNIPHOT", $status, $dbname); + } + } +} + +{ + my $command = "$relastro -objects"; + $command .= "-D CATDIR $dvodb"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $cal_id, $region, "RELASTRO.OBJECTS", $status, $dbname); + } +} + +{ + my $command = "$relastro -images"; + $command .= "-D CATDIR $dvodb"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $cal_id, $region, "RELASTRO.IMAGES", $status, $dbname); + } +} + +my $command = "$caltool -addrun"; +$command .= " -cal_id $cal_id"; +$command .= " -region $region"; +$command .= " -last_step RELASTRO.IMAGES"; +$command .= " -state 0"; +$command .= " -dbname $dbname" if defined $dbname; + +# Push the results into the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 1); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform regtool -addprocessedimfile: $error_code"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $cal_id = shift; + my $region = shift; + my $last_step = shift; + my $status = shift; + my $dbname = shift; + + carp($msg); + if (defined $cal_id && defined $region && defined $last_step && defined $status and not $no_update) { + my $command = "$caltool -addcalrun"; + $command .= " -cal_id $cal_id"; + $command .= " -region $region"; + $command .= " -last_step $last_step"; + $command .= " -state $status"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Pau. + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/camera_exp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/camera_exp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/camera_exp.pl (revision 41105) @@ -0,0 +1,554 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $psastro = can_run('psastro') or (warn "Can't find psastro" and $missing_tools = 1); +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $exp_tag, $cam_id, $camera, $outroot, $dbname, $reduction, $dvodb, $verbose, $no_update, + $no_op, $redirect, $save_temps, $run_state, $skip_binned, $skip_masks, $bkg_only); +GetOptions( + 'exp_tag=s' => \$exp_tag, # Exposure identifier + 'cam_id=s' => \$cam_id, # Camtool identifier + 'camera|c=s' => \$camera, # Camera + 'dbname|d=s' => \$dbname, # Database name + 'outroot|w=s' => \$outroot, # output file base name + 'reduction=s' => \$reduction, # Reduction class + 'dvodb|w=s' => \$dvodb, # output DVO database + 'run-state=s' => \$run_state, # 'new' or 'update' + 'skip-binned' => \$skip_binned, # override recipe - don't create binned images + 'skip-refmask' => \$skip_masks, # override recipe - don't create refmask +# 'bkg-only' => \$bkg_only, # override recipe - only do background continuity + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --exp_tag --cam_id --camera --outroot", + -exitval => 3, + ) unless + defined $exp_tag and + defined $cam_id and + defined $outroot and + defined $camera; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $cam_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +if (not defined $run_state) { $run_state = 'new'; } + +my_die ("$run_state is an invalid value for run-state", $cam_id, $PS_EXIT_PROG_ERROR) unless ($run_state eq 'new' or $run_state eq 'update'); + + +my $replicateOutputs = 1; + +$ipprc->outroot_prepare($outroot); + +my $logDest; +my $traceDest; +if ($run_state eq 'new') { + $logDest = prepare_output("LOG.EXP", $outroot, undef, 0); + $traceDest = prepare_output("TRACE.EXP", $outroot, undef, 0); +} else { + $logDest = prepare_output("LOG.EXP.UPDATE", $outroot, undef, 0); + $traceDest = prepare_output("TRACE.EXP.UPDATE", $outroot, undef, 0); +} + +if ($redirect) { + $ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $cam_id, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; + +my $recipe1 = $ipprc->reduction($reduction, 'JPEG_BIN1'); # Recipe to use +&my_die("Unrecognised JPEG recipe", $cam_id, $PS_EXIT_CONFIG_ERROR) unless defined $recipe1; + +my $recipe2 = $ipprc->reduction($reduction, 'JPEG_BIN2'); # Recipe to use +&my_die("Unrecognised JPEG recipe", $cam_id, $PS_EXIT_CONFIG_ERROR) unless defined $recipe2; + +#my $recipe_addstar = $ipprc->reduction($reduction, 'ADDSTAR'); # Recipe to use +#&my_die("Unrecognised ADDSTAR recipe", $cam_id, $PS_EXIT_CONFIG_ERROR) unless defined $recipe_addstar; + +my $recipe_psastro = $ipprc->reduction($reduction, 'PSASTRO'); # Recipe to use +&my_die("Unrecognised PSASTRO recipe", $cam_id, $PS_EXIT_CONFIG_ERROR) unless defined $recipe_psastro; + +my $bkg_recipe = 'PPIMAGE_BKGCONT'; # Add to reduction? +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my $recipeData; +{ + # Get the PSASTRO recipe + my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $cam_id, $PS_EXIT_CONFIG_ERROR); + } + $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $cam_id, $PS_EXIT_CONFIG_ERROR); +} + +my $cmdflags; + +# Get list of component files +# get FWHM statistics from input chip cmf files using ppStatsFromMetadata +my $files; # Array of component files +{ + my $command = "$camtool -pendingimfile -cam_id $cam_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool: $error_code", $cam_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $cam_id, $PS_EXIT_PROG_ERROR); + + # extract the metadata for the files into a hash list + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $cam_id, $PS_EXIT_PROG_ERROR); + + # since I can't figure out how to do input and output within PERL, I'm writing to a temp file + my ($statFile, $statName) = tempfile( "/tmp/$exp_tag.cm.$cam_id.stats.XXXX", UNLINK => !$save_temps ); + print "saving stats to $statName\n"; + foreach my $line (@$stdout_buf) { + print $statFile $line; + } + close $statFile; + + # parse the stats in the metadata file + $command = "$ppStatsFromMetadata $statName - CAMERA_EXP_IMFILE"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform ppStatsFromMetadata: $error_code\n"); + exit($error_code); + } + + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + # Determine if FWHM is too large to bother continuing. + my $maxFWHM = metadataLookupF32($recipeData, 'PSASTRO.MAX.ALLOWED.FWHM'); + if ($maxFWHM) { + my $expFWHM; + ($expFWHM) = $cmdflags =~ /-fwhm_major (\d+)/; + + if ($expFWHM > $maxFWHM) { + print "Setting quality to 4007 due to large FWHM: exposure: $expFWHM maximum: $maxFWHM\n"; + $cmdflags .= " -quality 4007 "; # This corresponds to PSASTRO_ERR_DATA + $no_op = 1; + } + } +} + + +my $do_masks; # Produce masks? +if (!$skip_masks) { + $do_masks = metadataLookupBool($recipeData, 'REFSTAR_MASK'); +} + +### not needed to have such an extensive temp file name. +my ($list1File, $list1Name) = tempfile( "/tmp/$exp_tag.cm.$cam_id.b1.list.XXXX", UNLINK => !$save_temps ); # For binning 1 +my ($list2File, $list2Name) = tempfile( "/tmp/$exp_tag.cm.$cam_id.b2.list.XXXX", UNLINK => !$save_temps ); # For binning 2 +my ($list3File, $list3Name) = tempfile( "/tmp/$exp_tag.cm.$cam_id.b3.list.XXXX", UNLINK => !$save_temps ); # For astrometry + +### XXX for the moment, always generate the bright-star mask +my ($list4File, $list4Name) = tempfile( "/tmp/$exp_tag.cm.$cam_id.b4.list.XXXX", UNLINK => !$save_temps ); # For astrometry + +### Create temp file for background models +my ($list5File, $list5Name) = tempfile( "/tmp/$exp_tag.cm.$cam_id.b5.list.XXXX", UNLINK => !$save_temps ); # For background models + + +my $do_stats; +my $do_bkg; +my $do_jpegs; +my $fpaStats; +my $psastroInputArg; +if ($run_state eq 'new') { + $do_stats = 1; + $do_bkg = 1; + $do_jpegs = !$skip_binned; + $fpaStats = prepare_output("PSASTRO.STATS", $outroot, undef, 1); + $psastroInputArg = " -list $list3Name"; +} else { + # for $run_state eq 'update' we only rebuild the masks using psastro + $do_stats = 0; + $do_jpegs = 0; + $do_bkg = 1; # we could skip this step if camProcessedExp.backgroun_model is non zero + + if (!$do_masks) { + &my_die("run_state is update but do_masks is F. I have nothing to do!!", $cam_id, $PS_EXIT_UNKNOWN_ERROR) + } + + # the input to psastro is the original PSASTRO.OUTPUT + + # Check for file with rule PSASTRO.OUTPUT.ORGINAL + # This file will exist if we attempted to update this camRun before but faulted + # XXX: make sure cleanup deals with these files + my $inputObjects = $ipprc->filename("PSASTRO.OUTPUT.ORIGINAL", $outroot, undef); + if (!$ipprc->file_exists($inputObjects)) { + # not found so original file should still be in place. + # Rename it. + my $originalObjects = $ipprc->filename("PSASTRO.OUTPUT", $outroot, undef); + if ($ipprc->file_exists($originalObjects)) { + + unless ($ipprc->file_rename($originalObjects, $inputObjects)) { + &my_die("failed to rename $originalObjects to $inputObjects", $cam_id, $PS_EXIT_UNKNOWN_ERROR); + } + + # ok ready to go + } else { + print STDERR "failed to find input objects to update\n"; + print STDERR "Original file name: $originalObjects\n"; + print STDERR "Saved file name: $inputObjects\n"; + + &my_die("Cannot proceed.", $cam_id, $PS_EXIT_DATA_ERROR); + + # XXX: actually we could use the chip stage cmfs as inputs and turn on astrometry + # ... except that somebody (me) got the bright idea to save space and + # changed chip stage cleanup to remove them. So we're kind of stuck. + } + } + $psastroInputArg = " -file $inputObjects -skipastro"; +} + + +my @outMasks; # Names of output masks +my @bkg_models; # Names of output background models +foreach my $file (@$files) { + # we perform astrometry iff photometry output exists + next if $file->{quality} != 0; + + # use the path_base as OUTPUT root and convert the filenames with ipprc->filename: + my $class_id = $file->{class_id}; + + # If there is only one chip, we use this name for the input to addstar + # we expect the chip analysis stage to produce psphot output (cmf file) and two binned images + my $chipObjects = $ipprc->filename("PSPHOT.OUTPUT", $file->{path_base}, $class_id); + my $chipMask = $ipprc->filename("PPIMAGE.CHIP.MASK", $file->{path_base}, $class_id); + + print $list1File ($ipprc->filename("PPIMAGE.BIN1", $file->{path_base}, $class_id) . "\n"); + print $list2File ($ipprc->filename("PPIMAGE.BIN2", $file->{path_base}, $class_id) . "\n"); + print $list3File ($chipObjects . "\n"); + print $list4File ($chipMask . "\n"); + print $list5File ($ipprc->filename("PSPHOT.BACKMDL", $file->{path_base}, $class_id) . "\n"); + + push @outMasks, prepare_output("PSASTRO.OUTPUT.MASK", $outroot, $class_id, 1) if $do_masks; + push @bkg_models, prepare_output("PPIMAGE.BACKMDL", $outroot, $class_id, 1) if $do_bkg; +} +close $list1File; +close $list2File; +close $list3File; +close $list4File; +close $list5File; + +# Prepare the Output products + +# the camera configurations should define the psastro output to be a single file (MEF), regardless of the inputs +my $jpeg1 = prepare_output("PPIMAGE.JPEG1", $outroot, undef, 1) if $do_jpegs; +my $jpeg2 = prepare_output("PPIMAGE.JPEG2", $outroot, undef, 1) if $do_jpegs; +my $fpaObjects = prepare_output("PSASTRO.OUTPUT", $outroot, undef, 1) if !$bkg_only; + +my $configuration; +if ($run_state eq 'new') { + $configuration = prepare_output("PSASTRO.CONFIG", $outroot, undef, 1); +} else { + # Do not use the original recipes for updates because they might contain the + # recipe values that caused the masks to get fouled up in the first place + # $configuration = $ipprc->filename("PSASTRO.CONFIG", $outroot, undef); +} + + +unless ($no_op) { + + ## build the output JPEG images first so we get them even if the astrometry fails + + if ($do_jpegs) { + # Make the jpeg for binning 1 + my $command = "$ppImage -list $list1Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE $recipe1"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $cam_id, $error_code); + } + check_output($jpeg1, $replicateOutputs); + + # Make the jpeg for binning 2 + + $command = "$ppImage -list $list2Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE $recipe2"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $cam_id, $error_code); + } + check_output($jpeg2, $replicateOutputs); + } + + if (!$bkg_only) { + # run psastro on the chipObjects, producing fpaObjects + my $command; + $command = $psastro; + $command .= " $psastroInputArg"; + $command .= " -masklist $list4Name" if $do_masks; + $command .= " $outroot"; + $command .= " -recipe PSASTRO $recipe_psastro"; + $command .= " -Db PSASTRO:REFSTAR_MASK F" if !$do_masks; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + + if ($run_state eq 'new') { + $command .= " -dumpconfig $configuration"; + } elsif ($run_state eq 'update') { + $command .= " -ipprc $configuration" if $configuration; + } else { + &my_die("invalid value for run-state: $run_state", $cam_id, $PS_EXIT_CONFIG_ERROR); + } + $command .= " -stats $fpaStats -recipe PPSTATS CAMSTATS" if $do_stats; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + print STDERR (join "\n", @$stderr_buf); + &my_die("Unable to perform psastro: $error_code", $cam_id, $error_code); + } + + my $quality; # Quality flag + if ($do_stats) { + check_output($fpaStats, $replicateOutputs); + + my $fpaStatsReal = $ipprc->file_resolve($fpaStats); + + # parse stats from metadata + $command = "$ppStatsFromMetadata $fpaStatsReal - CAMERA_EXP_FPA"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $cam_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + ($quality) = $cmdflags =~ /-quality (\d+)/; + } + + if (!$quality) { + check_output($fpaObjects, $replicateOutputs); + + foreach my $outMask (@outMasks) { + check_output($outMask, $replicateOutputs); + } + + if ($run_state eq 'new') { + check_output($configuration, $replicateOutputs); + } + } + } + + # Construct FPA continuity corrected background images + if (($camera =~ /ISP/)||($camera =~ /HSC/)||($camera =~ /gpc2/i)) { + print "Skipping FPA continuity corrected background images for ISP\n"; + } elsif ($do_bkg) { + my $command; + $command = "$ppImage"; + $command .= " -list $list5Name $outroot"; + $command .= " -recipe PPIMAGE $bkg_recipe"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage to fix background: $error_code", $cam_id, $error_code); + } + foreach my $bkgModel (@bkg_models) { + check_output($bkgModel, $replicateOutputs); + } + if ($run_state eq 'new') { + $cmdflags .= " -background_model 1 "; + } else { + my $command = "camtool -updateprocessedexp -set_background_model 1 -fault 0 -cam_id $cam_id"; + $command .= " -dbname $dbname" if $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to updateprocessedexp to set background_model: $error_code", $cam_id, $error_code); + } + } + } +} + +my $dtime_script = (DateTime->now->mjd - $mjd_start) * 86400; + +my $fpaCommand = "$camtool -cam_id $cam_id"; +if ($run_state eq 'new') { + $fpaCommand .= " -addprocessedexp"; + $fpaCommand .= " -uri UNKNOWN"; + $fpaCommand .= " -path_base $outroot"; + $fpaCommand .= " $cmdflags"; + $fpaCommand .= " -hostname $host" if defined $host; + $fpaCommand .= " -dtime_script $dtime_script"; +} else { + $fpaCommand .= " -updaterun -set_state full"; +} +$fpaCommand .= " -dbname $dbname" if defined $dbname; + +# Add the result into the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $fpaCommand, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to add result to database: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $fpaCommand\n"; +} + +exit 0; + +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $class_id = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, $class_id, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $cam_id, $error); + + return $output; +} + +sub check_output +{ + my $file = shift; + my $replicate = shift; + + if (!defined $file) { + return; + } + + &my_die("Couldn't find expected output file: $file", $cam_id, $PS_EXIT_SYS_ERROR) unless + $ipprc->file_exists($file); + + # Funpack to confirm we've really made things correctly + my $diskfile = $ipprc->file_resolve($file); + if ($diskfile =~ /fits/) { + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $cam_id, $PS_EXIT_SYS_ERROR); + my $check_command = "$funpack -S $diskfile > /dev/null"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $check_command, verbose => $verbose); + if (!$success) { + &my_die("Output file not a valid fits file: $file", $cam_id, $PS_EXIT_SYS_ERROR); + } + } + ##### + + + my $scheme = file_scheme($file); + if ($replicate and $scheme and (file_scheme($file) eq 'neb')) { + $ipprc->replicate_file($file) or &my_die("failed to replicate: $file\n", $cam_id, $PS_EXIT_SYS_ERROR); + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $cam_id = shift; # Camtool identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $cam_id and not $no_update) { + my $command = "$camtool -cam_id $cam_id"; + if ($run_state eq 'new') { + $command .= " -addprocessedexp"; + $command .= " -uri UNKNOWN"; + $command .= " -fault $exit_code"; + $command .= " -path_base $outroot"; + $command .= " -path_base $outroot" if defined $outroot; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + } else { + $command .= " -updateprocessedexp"; + $command .= " -fault $exit_code"; + } + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/chip_imfile.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/chip_imfile.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/chip_imfile.pl (revision 41105) @@ -0,0 +1,863 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $nebrepair = can_run('neb-repair') or (warn "Can't find neb-repair" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my @ARGS = @ARGV; + +# Parse the command-line arguments +my ( $exp_id, $chip_id, $class_id, $chip_imfile_id, $uri, $camera, $outroot, $dbname, $run_state, $reduction, $threads, $verbose, + $no_update, $save_temps, $no_op, $redirect, $magicked, $deburned, $update_mode ); + +GetOptions( + 'exp_id=s' => \$exp_id, # Exposure identifier + 'chip_id=s' => \$chip_id, # Chiptool identifier + 'class_id=s' => \$class_id, # Class identifier + 'chip_imfile_id=s' => \$chip_imfile_id, # Unique file identifier + 'uri|u=s' => \$uri, # Input FITS file + 'camera|c=s' => \$camera, # Camera + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'run-state=s' => \$run_state, # current state of the run (new, update) + 'update-mode=s' => \$update_mode, # update_mode if non-zero do not use configdump + 'magicked=s' => \$magicked, # magicked state of input file + 'deburned=s' => \$deburned, # does deburned image exist? + 'threads=s' => \$threads, # Number of threads to use for ppImage + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --exp_id --chip_id --chip_imfile_id --class_id --uri --camera --outroot --run-state --dbname", + -exitval => 3) unless + defined $exp_id and + defined $chip_id and + defined $class_id and + defined $chip_imfile_id and + defined $uri and + defined $camera and + defined $outroot and + defined $dbname and + defined $run_state; + +my_die ("$run_state is an invalid value for run-state", $exp_id, $chip_id, $class_id, $PS_EXIT_PROG_ERROR) unless ($run_state eq 'new' or $run_state eq 'update'); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $exp_id, $chip_id, $class_id, $PS_EXIT_CONFIG_ERROR ); + +my $neb; +my $scheme = file_scheme($outroot); +if ($scheme and $scheme eq 'neb') { + $neb = $ipprc->nebulous(); +} + +my ($logRule, $traceDest); +if ($run_state eq 'new') { + $logRule = "LOG.IMFILE"; + $traceDest = prepare_output("TRACE.IMFILE", $outroot, $class_id, 1); +} else { + $logRule = "LOG.IMFILE.UPDATE"; + $traceDest = prepare_output("TRACE.IMFILE.UPDATE", $outroot, $class_id, 1); +} + +if ($redirect) { + my $logDest = $ipprc->filename($logRule, $outroot, $class_id); + + $ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR ); + + print STDOUT "\n\n"; + print STDOUT "Starting script $0 on $host\n\n"; + print STDOUT "FULL COMMAND: $0 @ARGS\n\n"; +} + + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_ppImage = $ipprc->reduction($reduction, 'CHIP_PPIMAGE'); # Recipe to use for ppImage +my $recipe_psphot = $ipprc->reduction($reduction, 'CHIP_PSPHOT'); # Recipe to use for psphot +unless ($recipe_ppImage and $recipe_psphot) { + &my_die("Couldn't find selected reduction for CHIP_PPIMAGE and CHIP_PSPHOT: $reduction\n", $exp_id, $chip_id, $class_id, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# &my_die("Couldn't find input file: $uri\n", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($uri); + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +my $source_id = $ipprc->source_id($dbname, $PS_TABLE_ID_CHIP); + +## these names are used in ppImage, and thus may be URIs +my $outputImage = prepare_output("PPIMAGE.CHIP", $outroot, $class_id, 1 ); +my $outputMask = prepare_output("PPIMAGE.CHIP.MASK", $outroot, $class_id, 1); +my $outputWeight = prepare_output("PPIMAGE.CHIP.VARIANCE", $outroot, $class_id, 1); +my $pattern = prepare_output("PPIMAGE.PATTERN", $outroot, $class_id, 1); +my $backmdl = prepare_output("PSPHOT.BACKMDL", $outroot, $class_id, 1); + +my $configuration; +my $outputSources; +my $outputPsf; +my $outputStats; +my $outputBin1; +my $outputBin2; +my $dump_config = 1; + +# Note: We currently always do_stats because we need the quality flags +# If run_state eq 'update' using the same file name wipes out the stats from the original processing which +# is arguably a bug. Since they are already in the database in that case this probably isn't a big +# deal +my $do_stats = 1; +$outputStats = prepare_output("PPIMAGE.STATS", $outroot, $class_id, 1); + +my $do_binned_images = 1; + +if ($run_state eq 'new') { + # prepare the files that are only created for a new run + $configuration = prepare_output("PPIMAGE.CONFIG", $outroot, $class_id, 1); +} else { + # If update_mode is non-zero we are going to update with current recipes. + # In this case dump the new configuration. + if ($update_mode) { + $configuration = prepare_output("PPIMAGE.CONFIG", $outroot, $class_id, 1); + } else { + $configuration = $ipprc->filename('PPIMAGE.CONFIG', $outroot, $class_id) + or &my_die("Missing entry from camera config: PPIMAGE.CONFIG", $exp_id, $chip_id, $class_id, $PS_EXIT_CONFIG_ERROR); + if ($ipprc->file_exists($configuration)) { + $dump_config = 0; + } else { + print STDERR "WARNING: Config dump file $configuration is missing. Using current recipes and file rules.\n"; + + # XXX: should we create a new config dump file? + # I vote yes but only if we can distingusing between temporarily unavailable and GONE. + my $gone = 0; + if (storage_object_exists($configuration, \$gone)) { + if ($gone) { + $configuration = prepare_output('PPIMAGE.CONFIG', $outroot, $class_id, 1); + # if we dump the config we need to insure that the config dump represents + # the full processing + } else { + # file is temporarily not available. Don't dump config. + $dump_config = 0; + } + } + } + } + + # make sure that any lingering destreak backup files are gone + $ipprc->delete_destreak_backup_file($outputImage) + or &my_die("failed to delete existing destreak backup image file", $exp_id, $chip_id, $class_id, $PS_EXIT_UNKNOWN_ERROR); + $ipprc->delete_destreak_backup_file($outputMask) + or &my_die("failed to delete existing destreak backup mask file", $exp_id, $chip_id, $class_id, $PS_EXIT_UNKNOWN_ERROR); + $ipprc->delete_destreak_backup_file($outputWeight) + or &my_die("failed to delete existing destreak backup weight file", $exp_id, $chip_id, $class_id, $PS_EXIT_UNKNOWN_ERROR); + + # don't do binned images when updating + $do_binned_images = 0; +} +if ($do_binned_images) { + $outputBin1 = prepare_output("PPIMAGE.BIN1", $outroot, $class_id, 1); + $outputBin2 = prepare_output("PPIMAGE.BIN2", $outroot, $class_id, 1); +} + +my $cmdflags; + +# Run ppImage +unless ($no_op) { + my $command; + + ## get the ppImage recipe for this camera and CHIP reduction + $command = "$ppConfigDump -dump-recipe PPIMAGE -recipe PPIMAGE $recipe_ppImage -"; + if ($dump_config) { + # use this camera's recipes + $command .= " -camera $camera"; + } else { + # get recipes as set in config dump file + $command .= " -ipprc $configuration"; + } + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + + my $do_photom = metadataLookupBool($recipeData, 'PHOTOM'); + if ($do_photom and ($run_state eq 'update')) { + # If previous psf file is ok skip photometry + if (rerun_photometry($outroot, $class_id)) { + carp "Will rerun photometry\n"; + } else { + $do_photom = 0; + } + } + if ($do_photom) { + $outputSources = prepare_output("PSPHOT.OUTPUT", $outroot, $class_id, 1); + $outputPsf = prepare_output("PSPHOT.PSF.SAVE", $outroot, $class_id, 1); + } + + my $no_compress_image = metadataLookupBool($recipeData, 'NO.COMPRESS'); + + my $useDeburnedImage = metadataLookupBool($recipeData, 'USE.DEBURNED.IMAGE'); + my $ppImageApplyBurntool = metadataLookupBool($recipeData, 'APPLY.BURNTOOL'); + my $burntoolArguments; + + if ($useDeburnedImage) { + my $useBestBurntool = metadataLookupBool($recipeData, 'USE.BEST.BURNTOOL'); + + ## Check that we have required programs: +# print STDERR "Inside burntool loop!\n"; + my $regtool = can_run('regtool') or &my_die ("Can't find regtool", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + my $burntool = can_run('burntool') or &my_die ("Can't find burntool", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + + ## Check the current burntool processing version: + my $regtool_state_cmd = "$regtool -processedimfile -exp_id $exp_id -class_id $class_id -limit 1"; + if (defined($dbname)) { + $regtool_state_cmd .= " -dbname $dbname"; + } + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $regtool_state_cmd, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform regtool: $error_code", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + + my $regData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse regtool metadata", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + my $regData2 = parse_md_list($regData); + + my $burntoolState = 999; + foreach my $regEntry (@$regData2) { + print "$regEntry->{exp_id} $regEntry->{burntool_state}\n"; + + if ($regEntry->{exp_id} == $exp_id) { + $burntoolState = $regEntry->{burntool_state}; + } + } + if ($burntoolState == 999) { + &my_die("Unable to find burntool_state in metadata", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + if ($burntoolState == 32767) { + $burntoolState = 0; + } + + ## Read camera config to get the current good burntool state : + ## XXX This is extremely slow. Any better way to do this? + ## my $camera_config_cmd = "$ppConfigDump -camera $camera -dump-camera -"; + ## ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + ## run(command => $camera_config_cmd, verbose => 0); + ## unless ($success) { + ## $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + ## &my_die("Unable to perform ppConfigDump: $error_code", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + ## } + ## + ## my $camData = $mdcParser->parse(join "", @$stdout_buf) or + ## &my_die("Unable to parse ppConfigDump metadata", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + + ## XXX short term hack until we have a C-based parser + my $burntoolStateGood = 14; + my $burntoolStateGoodUpdate = 13; + ## foreach my $camEntry (@$camData) { + ## if ($camEntry->{name} eq "BURNTOOL.STATE.GOOD") { + ## $burntoolStateGood = $camEntry->{value}; + ## } + ## if ($camEntry->{name} eq "BURNTOOL.STATE.GOOD.UPDATE") { + ## $burntoolStateGoodUpdate = $camEntry->{value}; + ## } + ## } + + if ($run_state eq 'new') { + print "burntool state vs burntoolStateGood : $burntoolState vs $burntoolStateGood\n"; + } else { + # if doing update go ahead if burntoolState is at least at BURNTOOL.STATE.GOOD.UPDATE + print "burntool state vs burntoolStateGoodUpdate : $burntoolState vs $burntoolStateGoodUpdate\n"; + $useBestBurntool = 0 if (abs($burntoolState) >= $burntoolStateGoodUpdate); + } + + if (abs($burntoolState) != $burntoolStateGood) { + if ($useBestBurntool) { + &my_die("Image burntool version does not match current accepted version.", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + else { + warn ("Image burntool version does not match current accepted version. Continuing as requested."); + # Internally pretend that we're at a good version. + if ($burntoolState < -10) { + $burntoolState = -1 * $burntoolStateGood; + } + elsif ($burntoolState > 10) { + $burntoolState = $burntoolStateGood; + } + elsif ($burntoolState == 0) { + # You've told me to use a deburned image, and that you don't care if it's the most recent. The database has told me + # that burntool has never been run on this image. We'll hope the database is wrong, but I don't really trust that. + warn ("burntool_state suggests no table will be found. This will likely crash."); + $burntoolState = -1 * $burntoolStateGood; + } + else { + &my_die("No valid burntool table will be found.", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + } + } + # resolve uri + my $uriReal = $ipprc->file_resolve( $uri ); + # If instance is not found or if it doesn't exist try running neb-repair on it + # Note: file_exists returns false if the file exists but has zero size + if (!$uriReal or !$ipprc->file_exists($uriReal)) { + my $repair_cmd = "$nebrepair $uri"; + my ($repair_success, $repair_error_code, $repair_full_buf, $repair_stdout_buf, $repair_stderr_buf ) = run(command => $repair_cmd, verbose => $verbose); + unless ($repair_success) { + &my_die("Unable to attempt repair: $uri $repair_error_code", $exp_id,$chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + $uriReal = $ipprc->file_resolve( $uri ); + } + + &my_die("Unable to resolve $uri on $host", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR) if !$uriReal; + + # if recipe option PPIMAGE:APPLY.BURNTOOL is set and the burntool information is stored in + # an external table (usual case), check the existence of that table file and set $burntoolArguments. + # If burntool state does not match, say if the burntool data is stored in a fits extension in + # the rawImfile, use the burntool program. + if ($ppImageApplyBurntool && ($burntoolState == -1 * $burntoolStateGood)) { + my $burntoolTable_uri = $uri; + $burntoolTable_uri =~ s/fits$/burn.tbl/; + my $burntoolTable_uriReal = $ipprc->file_resolve( $burntoolTable_uri ); + if ((!$burntoolTable_uriReal)||(!($ipprc->file_exists($burntoolTable_uri)))) { + my $repair_cmd = "$nebrepair $burntoolTable_uri"; + my ($repair_success, $repair_error_code, $repair_full_buf, $repair_stdout_buf, $repair_stderr_buf ) + = run(command => $repair_cmd, verbose => $verbose); + unless ($repair_success) { + &my_die("Unable to attempt repair: $uri $repair_error_code", $exp_id,$chip_id, $class_id, + $PS_EXIT_SYS_ERROR); + } + $burntoolTable_uriReal = $ipprc->file_resolve( $burntoolTable_uri ); + } + unless ($ipprc->file_exists($burntoolTable_uri)) { + &my_die("Couldn't find burntool table: $burntoolTable_uri",$exp_id,$chip_id,$class_id, + $PS_EXIT_SYS_ERROR); + } + $burntoolArguments = " -burntool $burntoolTable_uri"; + } else { + ## use external burntool program + + ## We now know that we have an image that has been burntooled. + my ($tempFile, $tempName) = tempfile( "/tmp/chip.$exp_id.$class_id.deburned.XXXX", + UNLINK => !$save_temps, SUFFIX => '.fits' ); + + # funpack into the temp file. + my $funpack_cmd = "$funpack -S $uriReal > $tempName"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $funpack_cmd, verbose => $verbose); + unless ($success) { + # Catch errors here + my $repair_cmd = "$nebrepair $uri"; + my ($repair_success, $repair_error_code, $repair_full_buf, $repair_stdout_buf, $repair_stderr_buf ) = run(command => $repair_cmd, verbose => $verbose); + unless ($repair_success) { + &my_die("Unable to attempt repair: $uri $repair_error_code", $exp_id,$chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $funpack_cmd, verbose => $verbose); + } + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform funpack: $error_code", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + + ## Construct commands to apply the pre-calculated burntool trailfits to the pixel data. + my ($burntoolTable_uri, $burntoolTable_uriReal); + my $burntool_cmd = "$burntool "; + + if ($burntoolState == -1 * $burntoolStateGood) { # Burntool information stored in an external table. + $burntoolTable_uri = $uri; + $burntoolTable_uri =~ s/fits$/burn.tbl/; + $burntoolTable_uriReal = $ipprc->file_resolve( $burntoolTable_uri ); + if ((!$burntoolTable_uriReal)||(!($ipprc->file_exists($burntoolTable_uri)))) { + my $repair_cmd = "$nebrepair $burntoolTable_uri"; + my ($repair_success, $repair_error_code, $repair_full_buf, $repair_stdout_buf, $repair_stderr_buf ) = run(command => $repair_cmd, verbose => $verbose); + unless ($repair_success) { + &my_die("Unable to attempt repair: $uri $repair_error_code", $exp_id,$chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + $burntoolTable_uriReal = $ipprc->file_resolve( $burntoolTable_uri ); + } + unless ($ipprc->file_exists($burntoolTable_uri)) { + # Catch errors here + &my_die("Couldn't find burntool table: $burntoolTable_uri",$exp_id,$chip_id,$class_id, $PS_EXIT_SYS_ERROR); + } + + $burntool_cmd .= "$tempName in=${burntoolTable_uriReal} persist=t apply=t"; + } + elsif ($burntoolState == $burntoolStateGood) { # Burntool information stored in a header table. + $burntool_cmd .= "$tempName persist=t apply=t"; + } + else { + &my_die("Image data not properly burntooled, impossible state", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + + ## Run burntool to change the pixels of tempfile, and repoint $uri to that file. + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = + run(command => $burntool_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform burntool: $error_code", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + + $uri = $tempName; + unless ($ipprc->file_exists($uri)) { + &my_die("Couldn't find deburned input file: $uri\n", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + + if ($dump_config) { + # tell ppImage to not apply burntool since we have done it here + $burntoolArguments = ' -Db PPIMAGE:APPLY.BURNTOOL F'; + } + # print STDERR "$uri $uriReal $tempName $burntoolTable_uri $burntoolTable_uriReal $burntool_cmd $save_temps\n"; + # exit(100); + + } + } + + my $tiltystreakApply = metadataLookupBool($recipeData, 'TILTYSTREAK.APPLY'); + if ($tiltystreakApply) { + # NOTE: application of TILTYSTREAK.APPLY was here. Removed after r35685 + &my_die("Unable to perform tiltystreak: code has been removed", $exp_id, $chip_id, $class_id, + $PS_EXIT_PROG_ERROR); + } + + $command = "$ppImage -file $uri $outroot"; + if ($dump_config) { + $command .= " -recipe PPIMAGE $recipe_ppImage"; + $command .= " -dumpconfig $configuration"; + } else { + $command .= " -ipprc $configuration"; + } + if ($do_photom) { + $command .= " -recipe PSPHOT $recipe_psphot"; + } else { + $command .= " -Db PPIMAGE:PHOTOM FALSE"; + } + if ($run_state eq "new" or $do_stats) { + $command .= " -recipe PPSTATS CHIPSTATS"; + $command .= " -stats $outputStats"; + $do_stats = 1; + } + if (!$do_binned_images) { + $command .= " -Db PPIMAGE:BIN1.FITS FALSE -Db PPIMAGE:BIN2.FITS FALSE"; + } + if ($no_compress_image) { + $command .= " -R PPIMAGE.CHIP FITS.TYPE NONE"; + } + if ($run_state eq 'update' and metadataLookupBool($recipeData, 'MASK.STATS')) { + $command .= " -Db PPIMAGE:MASK.STATS FALSE "; + } + $command .= $burntoolArguments if $burntoolArguments; + $command .= " -threads $threads" if defined $threads; + $command .= " -image_id $chip_imfile_id" if defined $chip_imfile_id; + $command .= " -source_id $source_id" if defined $source_id; + $command .= " -tracedest $traceDest"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $exp_id, $chip_id, $class_id, $error_code); + } + + ## allow the output images to be optional, depending on the recipe / reduction class + my $outputImageExpect = metadataLookupBool($recipeData, 'CHIP.FITS'); + my $outputMaskExpect = metadataLookupBool($recipeData, 'CHIP.MASK.FITS'); + my $outputWeightExpect = metadataLookupBool($recipeData, 'CHIP.VARIANCE.FITS'); + my $outputBackmdlExpect = metadataLookupBool($recipeData, 'BACKGROUND'); + my $outputPatternExpect = (metadataLookupBool($recipeData, 'PATTERN.ROW') or metadataLookupBool($recipeData, 'PATTERN.CELL')) ; + + my $quality; # Quality flag + if ($do_stats) { + my $outputStatsReal = $ipprc->file_resolve($outputStats); + &my_die("Couldn't find expected output file: $outputStats", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + # measure chip stats + $command = "$ppStatsFromMetadata $outputStatsReal - CHIP_IMFILE"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $exp_id, $chip_id, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + } + + if (!$quality) { + my $replicateImages = 0; + check_output($outputImage, $replicateImages) if $outputImageExpect; + check_output($outputMask, $replicateImages) if $outputMaskExpect; + check_output($outputWeight, $replicateImages) if $outputWeightExpect; + if ($do_binned_images) { + check_output($outputBin1, 1); + check_output($outputBin2, 1); + } + check_output($configuration, 1) if $dump_config; + check_output($backmdl, 1) if $outputBackmdlExpect; + # allow the pattern file to be missing if run state is update older data doesn't have one + # I should parse the config dump file to calculate the 'Expect' variables + check_output($pattern, 1, $run_state eq 'update') if $outputPatternExpect; + if ($do_photom) { + check_output($outputSources, 1); + check_output($outputPsf, 1); + } + # XXX: Do we want to replicate the stats, logs, trace file? + } +} + +my $command; +if ($run_state eq 'new') { + # command to update database + $command = "$chiptool -addprocessedimfile"; + $command .= " -exp_id $exp_id"; + $command .= " -chip_id $chip_id"; + $command .= " -class_id $class_id"; + $command .= " -uri $outputImage"; + $command .= " -path_base $outroot"; + $command .= " -magicked $magicked" if $magicked; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " $cmdflags"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); +} else { + $command = "$chiptool -tofullimfile"; + $command .= " -chip_id $chip_id"; + $command .= " -class_id $class_id"; + $command .= " -dbname $dbname" if defined $dbname; + # XXX: if we had a quality problem on this re-run we are not saving that fact in the DB... + # to change this we need to modify chiptool -tofullimfile to supprot -set_quality and then add + #$command .= " -set_quality $quality" if $quality; +} + +# Add the processed file to the database +my $tries = 0; +while (1) { + $tries++; + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform chiptool -addprocessedimfile: $error_code\n"); + exit($error_code) if $tries >= 3; + warn("Waiting 10 seconds to try again\n"); + sleep 10; + } else { + last; + } + } else { + print "skipping command: $command\n"; + last; + } +} + +exit 0; + +# check whether psphot outputs should be regenerated. +# Whether we need to or not was a somewhat complicated question. Since we clean cmfs now we only rerun +# photometry if the psf file has gone missing since it is needed to run warps + +sub rerun_photometry +{ + my $outroot = shift; + my $class_id = shift; + my $outputSources = $ipprc->filename('PSPHOT.OUTPUT', $outroot, $class_id) + or &my_die("Missing entry from camera config: PSPHOT.OUTPUT", $exp_id, $chip_id, $class_id, $PS_EXIT_CONFIG_ERROR); + + my $update_sources_if_gone = 0; # set this to regenerate sources if gone. + # We no longer do this as of 2012-12 since cleanup deletes them + my $make_sources = 0; + my $sources_available = 0; + if ($ipprc->file_exists($outputSources)) { + $sources_available = 1; + } else { + if ($update_sources_if_gone) { + carp "WARNING: photometry sources file $outputSources is not available"; + my $gone; + if (storage_object_exists($outputSources, \$gone)) { + # check whether the file is permanantely or temporarily gone + if ($gone) { + carp "WARNING: photometry sources storage object exists but all instances are permanently gone"; + $ipprc->file_rename($outputSources,$outputSources . ".gone"); + $make_sources = 1; + } + } else { + # storage object must have been deleted + $make_sources = 1; + } + } + } + + my $make_psf = 0; + my $psf_available = 0; + my $outputPsf = $ipprc->filename("PSPHOT.PSF.SAVE", $outroot, $class_id) + or &my_die("Missing entry from camera config: PSPHOT.PSF.SAVE", + $exp_id, $chip_id, $class_id, $PS_EXIT_CONFIG_ERROR); + + if ($ipprc->file_exists($outputPsf)) { + $psf_available = 1; + } else { + carp "PSF file $outputPsf is missing"; + my $gone = 0; + if (storage_object_exists($outputPsf, \$gone)) { + # object exists, but no instances are available. If they are permanently gone + # remake it + if ($gone) { + carp "WARNING: PSF storage object exists but all instances are permanently gone"; + $ipprc->file_rename($outputPsf,$outputPsf . ".gone"); + $make_psf = 1; + } + } else { + # object completely missing remake it + $make_psf = 1; + } + } + + if ($sources_available && $psf_available) { + return 0; + } + + if ($update_sources_if_gone) { + if (!$sources_available && !$make_sources) { + # destreak will die if the sources is not available + # but magic is dead.... + &my_die("PSPHOT.SOURCES is missing but we cannot regenerate it", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + } + + if (!$psf_available && !$make_psf) { + # warp updates need the psf file + &my_die("PSPHOT.PSF.SAVE is missing but we cannot regenerate it", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + + return $make_psf || $make_sources; +} + +# subroutine to check the status of a nebulous file. Used to distinguish between a storage object that +# does not exist and one that all of the instances have been lost. +# XXXX This should be implemented properly in Nebulous +# For now uses Bill's script 'whichnode' which queries the nebulous database directly + +my $whichnode; +sub storage_object_exists +{ + return 0 if !$neb; + + my $file = shift; + my $ref_all_gone = shift; + + + my $exists = $neb->storage_object_exists($file); + if (!$exists) { + return 0; + } + + if (!$whichnode) { + $whichnode = can_run('whichnode') or + &my_die("Can't find whichnode", $exp_id, $chip_id, $class_id, $PS_EXIT_CONFIG_ERROR); + } + + my $command = "$whichnode $file"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform whichnode: $error_code", $exp_id, $chip_id, $class_id, $PS_EXIT_CONFIG_ERROR); + } + + my @lines = split "\n", (join "", @$stdout_buf); + + if (scalar @lines == 0) { + # no output the file is really and truely gone + # XXX: this is now caught above + print STDERR "storage object for $file does not exist\n"; + return 0; + } + + my $numGone = 0; + my $numNotGone = 0; + foreach my $line (@lines) { + chomp $line; + + # output lines are either + # "volume available" + # or + # "volume not available" + + my ($volume, $answer, undef) = split " ", $line; + # our hack is if the volume has an X in the name it's gone + if ($volume =~ /X/) { + print STDERR "$file is on $volume which is gone\n"; + $numGone++; + } elsif ($answer eq 'permanently') { + $numGone++; + } elsif ($answer eq 'available') { + $numNotGone++; + } elsif ($answer eq 'not') { + print STDERR "$file is on $volume which is not available\n"; + $numNotGone++; + } else { + print STDERR "unexpected output from whichnode: $line\n"; + } + } + # if there are any instances that are not on a gone volume set all_gone to 0 + if ($numNotGone == 0 and $numGone > 0) { + $$ref_all_gone = 1; + } else { + $$ref_all_gone = 0; + } + + # storage object exists so return true + return 1; +} + +# Prepare to write to an output file +# Lookup the filename in the rules. +# Make sure that if file exists and is a nebulous file that there is only one instance +# Deal with files that have been lost. +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $class_id = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, $class_id, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $exp_id, $chip_id, $class_id, $error); + return $output; +} + +sub check_output +{ + my $file = shift; + my $replicate = shift; + my $allow_missing = shift; + + if (!defined $file) { + return; + } + + my $exists = $ipprc->file_exists($file); + + if (!$exists) { + if ($allow_missing) { + carp("Couldn't find expected output_file: $file but continuing anyways\n"); + return 1; + } + &my_die("Couldn't find expected output file: $file", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + # Funpack to confirm we've really made things correctly + my $diskfile = $ipprc->file_resolve($file); + if ($diskfile =~ /fits/) { + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + my $check_command = "$funpack -S $diskfile > /dev/null"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $check_command, verbose => $verbose); + if (!$success) { + &my_die("Output file not a valid fits file: $file", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } + } + ##### + + if ($replicate and $neb) { + $ipprc->replicate_file($file) or &my_die("failed to replicate: $file\n", $exp_id, $chip_id, $class_id, $PS_EXIT_SYS_ERROR); + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $exp_id = shift; # Chiptool identifier + my $chip_id = shift; # Chiptool identifier + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + # run_state, outputImage, and outroot are globals + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $chip_id and defined $class_id and not $no_update) { + my $command; + if ($run_state eq 'new') { + $command = "$chiptool -addprocessedimfile"; + $command .= " -exp_id $exp_id"; + $command .= " -uri $outputImage" if defined $outputImage; + $command .= " -path_base $outroot"; + $command .= " -hostname $host" if defined $host; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + } else { + $command .= "$chiptool -updateprocessedimfile"; + } + $command .= " -chip_id $chip_id"; + $command .= " -class_id $class_id"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/destreak_restore_camera.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/destreak_restore_camera.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/destreak_restore_camera.pl (revision 41105) @@ -0,0 +1,549 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print STDERR "\n\n"; +print STDERR "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Digest::MD5::File qw( file_md5_hex ); + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename dirname ); +use File::Copy; +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); +use Nebulous::Client; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $checkfits = can_run('checkfits') or (warn "Can't find checkfits" and $missing_tools = 1); +my $ftable = can_run('ftable') or (warn "Can't find ftable" and $missing_tools = 1); +my $censorObjects = can_run('censorObjects') or (warn "Can't find censorObjects" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($magic_ds_id, $camera, $streaks, $cam_id, $uri, $path_base); +my ($outroot, $release, $bytes, $md5sum); +my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile); + +GetOptions( + 'magic_ds_id=s' => \$magic_ds_id,# Magic destreak run identifier + 'camera=s' => \$camera, # path_base of the input + 'cam_id=s' => \$cam_id, + 'path_base=s' => \$path_base, # path_base of the input + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --magic_ds_id --camera --cam_id --path_base", + -exitval => 3) unless + defined $magic_ds_id and + defined $camera and + defined $cam_id and + defined $path_base; + +if ($camera ne 'GPC1') { + my_die("camera must be GPC1 not $camera ", $magic_ds_id, $PS_EXIT_PROG_ERROR); +} + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_ds_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +$ipprc->redirect_to_logfile($logfile) or my_die( "Unable to redirect output", $magic_ds_id, $PS_EXIT_SYS_ERROR ) if $logfile; + +my $nebulousServer = $ENV{NEB_SERVER}; +&my_die("cannot find NEB_SERVER in environment", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if !$nebulousServer; + +my $nebulous = eval { Nebulous::Client->new( proxy => $nebulousServer ); }; +if ($@ or not defined $nebulous) { + &my_die ("Unable to create a Nebulous::Client object with proxy $nebulousServer", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my $dirname = dirname($path_base); +my $basename = basename($path_base); +my $nebulousInput = inNebulous($dirname); + +&my_die ("$dirname is not in nebulous", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) unless $nebulousInput; + +my $backup_path_base = $dirname . "/SR_" . "$basename"; +my $recovery_path_base = $dirname . "/REC_" . "$basename"; + +my $astrom = $ipprc->filename("PSASTRO.OUTPUT", $path_base); +my $bastrom = $ipprc->filename("PSASTRO.OUTPUT", $backup_path_base); + +restore_file($astrom, $bastrom, 1) or + &my_die("failed to restore smf file", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); + +# Now restore the mask files + +my @otas = qw(XY01 XY02 XY03 XY04 XY05 XY06 XY10 XY11 XY12 XY13 XY14 XY15 XY16 XY17 XY20 XY21 XY22 XY23 XY24 XY25 XY26 XY27 XY30 XY31 XY32 XY33 XY34 XY35 XY36 XY37 XY40 XY41 XY42 XY43 XY44 XY45 XY46 XY47 XY50 XY51 XY52 XY53 XY54 XY55 XY56 XY57 XY60 XY61 XY62 XY63 XY64 XY65 XY66 XY67 XY71 XY72 XY73 XY74 XY75 XY76); + +foreach my $class_id (@otas) { + my $mask = "$path_base.$class_id.mk.fits"; + my $bmask = "$backup_path_base.$class_id.mk.fits"; + my $rmask = "$recovery_path_base.$class_id.mk.fits"; + if (!restore_file($mask, $bmask, 0)) { + # no good mask file. Mark any chips that need this mask file to be useful as bad + # XXX: what about chipRuns with multiple camRuns can't we preserve those? + my $command = "$chiptool -dropprocessedimfile -cam_id $cam_id -class_id $class_id -set_quality 45"; + $command .= " -dbname $dbname" if defined $dbname; + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magicdstool -addresult: $error_code", $magic_ds_id, + $error_code); + } + } else { + print "Skipping command: $command\n"; + } + } +} + +{ + # this sets the camRun's magicked value back to zero and deletes the magicDSFile + # row from the database + my $command = "$magicdstool -revertdestreakedfile -i_am_sure"; + $command .= " -state goto_restored"; + $command .= " -magic_ds_id $magic_ds_id"; + $command .= " -component exposure"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magicdstool -addresult: $error_code", $magic_ds_id, + $error_code); + } + } else { + print "Skipping command: $command\n"; + } +} +{ + # this sets the magicDSRun.state to restored + my $command = "$magicdstool -updaterun"; + $command .= " -set_state restored"; + $command .= " -magic_ds_id $magic_ds_id"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magicdstool -addresult: $error_code", $magic_ds_id, + $error_code); + } + } else { + print "Skipping command: $command\n"; + } +} +exit 0; + +### Pau. + +sub restore_file { + my $original_url = shift; + my $backup_url = shift; + my $smf = shift; + + print "\nStarting restore for $original_url\n"; + + # It is the backup that we expect to want to use, check it first. + my $backup = check_file($backup_url, 1, $smf); + + # Is backup a good file whether censored or not? + my $backup_ok = ($backup->{so_exists} and $backup->{num_instances}); + + # Check original, skip full check if backup is ok and uncensored since the backup + # is the one that we want to keep. + my $original = check_file($original_url, (!$backup_ok or $backup->{censored}), $smf); + + my $swap_urls = 0; + my $kill_censored = 0; + my $replicate = 0; + + if ($backup_ok and !$backup->{censored}) { + # + # Normal case. A good uncensored backup file is available + # + if ($backup->{inconsistent}) { + # At least one of the instances was bad. Repair. + repair_file($backup, $smf) or + &my_die( "failed to repair $backup_url", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); + } + + $replicate = $backup->{num_instances} < 2; + + if ($original->{so_exists}) { + # + # Normal case. + # + $swap_urls = 1; + $kill_censored = 1; + } else { + # no file at original url rename the backup + # note: rename_file prints a message and dies on failure + rename_file($backup_url, $original_url); + } + } else { + # Something is wrong with the backup file, either not ok or censored + # check the original + my $original_ok = ($original->{so_exists} and $original->{num_instances}); + if ($original_ok) { + if ($original->{inconsistent}) { + repair_file($original, $smf) or + &my_die( "failed to repair $original_url", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); + } + if (!$original->{censored}) { + # Note this is where we end up if this file has already been restored + print "Keeping uncensored file at original url: $original_url\n"; + } else { + print "No uncensored backup. Keeping censored file at original url: $original_url\n"; + } + $kill_censored = $backup->{so_exists}; + $replicate = $original->{num_instances} < 2; + } else { + # Original is bad. Is the backup at least a good file. If so swap it back in even if it is censored. + if ($backup_ok) { + print "No file found at $original_url\n"; + print "Swapping in $backup_url\n"; + if ($backup->{inconsistent}) { + repair_file($backup, $smf) or + &my_die( "failed to repair $backup_url", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); + } + $replicate = $backup->{num_instances} < 2; + if ($original->{so_exists}) { + $swap_urls = 1; + $kill_censored = 1; + } else { + # note: rename_file prints a message and dies on failure + rename_file($backup_url, $original_url); + } + } else { + # we're out of luck + print "No good file for $original_url found\n"; + return 0; + } + } + } + + # Ok Now we know what we need to do so do it + + if (!$no_op) { + if ($swap_urls) { + if (! $nebulous->swap($backup_url, $original_url) ) { + print "failed to swap $backup_url\n"; + print " to $original_url\n"; + &my_die( "aborting", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); + } else { + print "restored $original_url\n"; + } + } + if ($kill_censored) { + # destroy the backup file + $ipprc->kill_file($backup_url); + } + + if ($replicate) { + $ipprc->replicate_file($original_url) + or &my_die( "failed to replicate $original_url", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); + } + } else { + print "Skipping:\n"; + print " Swap urls $backup_url $original_url\n" if $swap_urls; + print " Delete $backup_url\n" if $swap_urls; + print " Replicate $original_url\n" if $replicate; + } + + return 1; +} + +sub check_file { + my $url = shift; + my $full_check = shift; + my $smf = shift; + + my %file; + $file{url} = $url; + $file{so_exists} = $nebulous->storage_object_exists($url); + $file{total_instances} = 0; + $file{num_instances} = 0; + $file{censored} = 0; + $file{inconsistent} = 0; + $file{instances} = []; + $file{bad_instances} = []; + $file{size} = 0; + $file{md5} = 0; + + if ($file{so_exists}) { + my $stat = $nebulous->stat($url); + + &my_die("nebulous stat failed for $url", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) unless $stat; + + $file{total_instances} = $stat->[7]; + + if ($file{total_instances}) { + my $instances; + eval { + $instances = $nebulous->find_instances($url, 'any'); + }; + if (!$instances or !scalar @$instances) { + print "No instances found for $url\n"; + return \%file; + } + + my $good_inst; + my $good_size = 0; + my $good_md5 = ""; + my $good_censored ; + foreach my $inst (@$instances) { + $inst =~ s/file\:\/\///g; + + if ( ! -e $inst) { + print "instance file $inst does not exist\n"; + push @{$file{bad_instances}}, $inst; + next; + } + my $this_size = -s $inst; + if (!$this_size) { + print "instance file $inst has zero size\n"; + push @{$file{bad_instances}}, $inst; + next; + } + + my $this_censored = ($inst =~ /SR_/); + + my $this_md5 = ""; + if ($full_check) { + $this_md5 = file_md5_hex($inst); + if ($smf) { + my $command = "$ftable -list $inst | grep psf | wc"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + my $good = 0; + if ($success) { + my ($nchips) = split " ", join "", @$stdout_buf; + $nchips += 0; + if ($nchips and $nchips == 60) { + $good = 1; + } else { + print "$inst has less than 60 psf extensions: $nchips checking with censorObjects\n"; + my $command = "$censorObjects -checkinputonly -file $inst"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + if ($success) { + $good = 1; + } else { + print "$command failed with error_code: $error_code\n", + } + } + } else { + print "$command failed with error_code: $error_code\n", + } + if (!$good) { + push @{$file{bad_instances}}, $inst; + next; + } + } else { + my $command = "$checkfits $inst"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + print "$command failed with error_code: $error_code\n", + push @{$file{bad_instances}}, $inst; + next; + } + } + } + if (!defined $good_inst) { + $good_inst = $inst; + $good_size = $this_size; + $good_md5 = $this_md5; + $good_censored = $this_censored; + + push @{$file{instances}}, $inst; + + # unless we're asked for a full all really care about is the censored status + last if !$full_check; + } elsif ($this_size != $good_size) { + print "size of $inst $this_size is not equal to size of $good_inst: $good_size\n"; + $file{inconsistent} = 1; + push @{$file{bad_instances}}, $inst; + } elsif ($this_md5 ne $good_md5) { + print "md5 of $inst $this_md5 is not equal to size of $good_inst: $good_md5\n"; + $file{inconsistent} = 1; + push @{$file{bad_instances}}, $inst; + } else { + # this matches the good instance + push @{$file{instances}}, $inst; + } + } + $file{num_instances} = scalar @{$file{instances}}; + $file{size} = $good_size; + $file{md5} = $good_md5; + if ($good_inst) { + $file{censored} = $good_censored; + } else { + # no good instances see if there was a bad one and check whether its url + # looks like a censored one + if (scalar @{$file{bad_instances}}) { + my $bad = ${$file{bad_instances}}[0]; + $file{censored} = ($bad =~ /SR_/); + print "no good instances found setting censored based on $bad\n"; + } + } + } + } else { + print "No storage object found for $url \n"; + } + + return \%file; +} + +sub rename_file { + if ($no_op) { + return 1; + } + + my $backup_url = shift; + my $original_url = shift; + + # rename the backup as the orig + print "No storage object for original url: $original_url\n"; + print "Replacing with file at : $backup_url\n"; + + my $moved; + eval { + $moved = $nebulous->move($backup_url, $original_url); + }; + if ($@ or not $moved) { + print "Failed to move $backup_url to $original_url\n"; + &my_die( "aborting", $magic_ds_id, $PS_EXIT_CONFIG_ERROR); + } +} + +sub repair_file { + if ($no_op) { + return 1; + } + + my $file = shift; + my $smf = shift; + + if ($file->{num_instances} < 1) { + print "cannot repair file with only no good instances\n"; + return 0; + } + + # file wouldn't get into instances array unless we decided that it was good in check_file + my $good_inst = $file->{instances}->[0]; + + my $fixed = 0; + foreach my $bad_inst (@{$file->{bad_instances}}) { + print "Attempting to repair $bad_inst\n"; + + my $parent_directory = dirname($bad_inst); + if (!-d $parent_directory) { + if (! mkdir $parent_directory) { + print "failed to mkdir parent directory $parent_directory\n"; + $fixed = 0; + last; + } + if (!copy $good_inst, $bad_inst) { + print "failed to copy $good_inst to $bad_inst\n"; + } + $fixed = 1; + push @{$file->{instances}}, $bad_inst; + } + } + + return $fixed; +} + + + +sub delete_recovery_files +{ + foreach my $file (@_) { + next if !$file; + # don't care if this fails or not (it will fail if storage + # object doesn't exist + $ipprc->kill_file($file); + } +} + +sub inNebulous +{ + my $path = shift; + + my $scheme = file_scheme($path); + + return $scheme and ($scheme eq "neb"); +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $magic_ds_id = shift; # Magic DS identifier + my $exit_code = shift; # Exit code to add + + carp($msg); + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + # fault the whole run if one of the components fails to revert + my $command = "$magicdstool -updaterun"; + $command .= " -magic_ds_id $magic_ds_id"; + $command .= " -set_state failed_restore"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_ds_id"); + } + } else { + print "Skipping command: $command\n"; + } + + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_correct_imfile.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_correct_imfile.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_correct_imfile.pl (revision 41105) @@ -0,0 +1,151 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $dvoApplyCorr = can_run('dvoApplyCorr') or (warn "Can't find dvoApplyCorr" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $det_id, $class_id, $det_type, $input_uri, $camera, $dbname, + $verbose, $no_update, $no_op, $outroot, $redirect, $corr_uri ); +GetOptions( + 'det_id|d=s' => \$det_id, + 'class_id|i=s' => \$class_id, + 'det_type|t=s' => \$det_type, + 'input_uri|u=s' => \$input_uri, + 'corr_uri|u=s' => \$corr_uri, + 'outroot|o=s' => \$outroot, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --class_id --det_type --input_uri --camera --outroot", + -exitval => 3) + unless defined $det_id + and defined $class_id + and defined $det_type + and defined $input_uri + and defined $outroot + and defined $camera; + +# force det_type to be upper-case in this script +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $class_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +if ($redirect) { + my $logDest = $ipprc->filename("LOG.IMFILE", $outroot, $class_id) + or &my_die("Missing entry from camera config", $det_id, $class_id, $PS_EXIT_CONFIG_ERROR); + $ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $det_id, $class_id, $PS_EXIT_SYS_ERROR ); +} + +# Recipes to use as a function of detrend type +# XXX there are no recipe options for dvoApplyCorr... +# XXX in the future, we may define corrections other than the flat-field correction +# $reduction = "DETREND" unless defined $reduction; +# my $recipe = $ipprc->reduction($reduction, uc($det_type) . '_CORRECT'); # Recipe name to use + +# XXX for now, check and warn, but don't exit on unexpected det_types +# det_type is type of the CORRECTED (output) file +if ($det_type ne "FLAT") { warn ("unexpected input detrend type: correcting data of type $det_type"); } + +&my_die("Couldn't find input file: $input_uri\n", $det_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($input_uri); + +my $outputImage = $ipprc->filename("DVOFLAT.OUTPUT", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $class_id, $PS_EXIT_PROG_ERROR); + +# Run dvoApplyCorr +unless ($no_op) { + # unless explicitly supplied, the correction image is determined by dvoApplyCorr via look up to the detrend database + my $command = "$dvoApplyCorr -file $input_uri $outroot"; + $command .= " -corr $corr_uri" if defined $corr_uri; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $det_id, $class_id, $error_code); + } + + &my_die("Couldn't find expected output file: $outputImage", $det_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputImage); +} + +# command to update database +my $command = "$dettool -addcorrectimfile"; +$command .= " -det_id $det_id"; +$command .= " -class_id $class_id"; +$command .= " -uri $outputImage"; +$command .= " -path_base $outroot"; +$command .= " -dbname $dbname" if defined $dbname; + +# Add the processed file to the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -addcorrectimfile: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $class_id and not $no_update) { + my $command = "$dettool -addcorrectimfile"; + $command .= " -det_id $det_id"; + $command .= " -class_id $class_id"; + $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_apply.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_apply.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_apply.pl (revision 41105) @@ -0,0 +1,248 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line +my ( $det_id, $iter, $class_id, $value, $input_uri, $camera, $det_type, $outroot, $dbname, $verbose, + $no_update, $no_op, $redirect ); +GetOptions( + 'det_id|d=s' => \$det_id, # Detrend ID + 'iteration|n=s' => \$iter, # Iteration + 'class_id|i=s' => \$class_id, # Class ID + 'value|v=s' => \$value, # Value to apply (for normalisation) + 'input_uri|u=s' => \$input_uri, # Input file + 'camera|c=s' => \$camera, # Camera + 'det_type|t=s' => \$det_type, # Detrend type + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database + 'no-op' => \$no_op, # Don't do any operations + 'redirect-output' => \$redirect, # send output from script to LOG.IMFILE + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --iteration --class_id --value --input_uri --camera --det_type --outroot", + -exitval => 3) unless + defined $det_id and + defined $iter and + defined $class_id and + defined $value and + defined $input_uri and + defined $camera and + defined $det_type and + defined $outroot; + +# force det_type to be upper-case in this script +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.IMFILE", $outroot, $class_id) + or &my_die("Missing entry from camera config", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); +$ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +my $RECIPE_PPIMAGE = 'PPIMAGE_N'; # Recipe to use with ppImage + +# Define which detrend types we normalise +use constant DETTYPE => { + 'BIAS' => 'BIAS', + 'DARK' => 'DARK', + 'DARK_PREMASK' => 'DARK', + 'SHUTTER' => 'SHUTTER', + 'FLAT_PREMASK' => 'FLAT', + 'DOMEFLAT_PREMASK' => 'FLAT', + 'SKYFLAT_PREMASK' => 'FLAT', + 'FLAT_RAW' => 'FLAT', + 'DOMEFLAT_RAW' => 'FLAT', + 'SKYFLAT_RAW' => 'FLAT', + 'SKYFLATTEST_RAW' => 'FLAT', + 'FLAT' => 'FLAT', + 'FLATTEST' => 'FLAT', + 'DOMEFLAT' => 'FLAT', + 'SKYFLAT' => 'FLAT', + 'FRINGE' => 'FRINGE', + 'MASK' => 'MASK', + 'DARKMASK' => 'MASK', + 'FLATMASK' => 'MASK', + 'CTEMASK' => 'MASK', + 'DARKTEST' => 'DARK', + 'NOISEMAP' => 'MASK', + }; + +# convert supplied detrend type to a controlled namespace +&my_die("Unrecognised detrend type: $det_type", $det_id, $iter, $class_id, $PS_EXIT_PROG_ERROR) unless exists DETTYPE()->{$det_type}; +my $det_type_real = DETTYPE()->{$det_type}; + +&my_die("Couldn't find input file: $input_uri\n", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($input_uri); + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +my $outFile = ($det_type_real eq "MASK") ? 'PPIMAGE.OUTPUT.DETMASK' : 'PPIMAGE.OUTPUT';; # XXXX something of a hack (too many places to control things...) + +my $RECIPE_PPSTATS = ($det_type_real eq "DARK") ? 'DARKSTATS' : 'DETSTATS';; # XXXX something of a hack (too many places to control things...) + +my $output = $ipprc->filename($outFile, $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); +my $b1name = $ipprc->filename("PPIMAGE.BIN1", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); +my $b2name = $ipprc->filename("PPIMAGE.BIN2", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); +my $statsName = $ipprc->filename("PPIMAGE.STATS", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); +my $traceDest = $ipprc->filename("TRACE.IMFILE", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); + +my $cmdflags; + +# Run normalisation +unless ($no_op) { + + # we cannot use ppImage to load a normalized mask : just copy it and build the jpeg images + if ($det_type_real eq 'MASK') { + $RECIPE_PPIMAGE = 'PPIMAGE_BIN'; + my $input_real = $ipprc->file_resolve($input_uri, 0); + my $output_real = $ipprc->file_resolve($output, 1); + system ("cp $input_real $output_real"); + } + + my $command = "$ppImage -file $input_uri $outroot"; + $command .= " -norm $value -stats $statsName"; + $command .= " -recipe PPIMAGE $RECIPE_PPIMAGE"; + $command .= " -recipe PPSTATS $RECIPE_PPSTATS"; + $command .= " -F PPIMAGE.OUTPUT $outFile" unless $outFile eq 'PPIMAGE.OUTPUT'; + $command .= ' -isfringe' if $det_type_real eq 'FRINGE'; + $command .= ' -isdark' if $det_type_real eq 'DARK'; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $det_id, $iter, $class_id, $error_code); + } + &my_die("Can't find expected output file: $output", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($output); + &my_die("Can't find expected output file: $b1name", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($b1name); + &my_die("Can't find expected output file: $b2name", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($b2name); + + my $statsNameReal = $ipprc->file_resolve($statsName); + &my_die("Can't find expected output file: $statsName", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($statsNameReal); + + # parse stats from metadata + $command = "$ppStatsFromMetadata $statsNameReal - DETREND_NORM_APPLY"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $det_id, $iter, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + # replicate output file + my $scheme = file_scheme ($output); + if ($scheme eq "neb") { + $ipprc->replicate_file($output) or &my_die("failed to replicate: $output\n", $det_id,$iter,$class_id,$PS_EXIT_SYS_ERROR); + } else { + print "output $output is a file or path, not a nebulous key: skipping replication\n"; + } +} + +# Command to update the database +my $command = "$dettool -addnormalizedimfile"; +$command .= " -det_id $det_id"; +$command .= " -iteration $iter"; +$command .= " -class_id $class_id"; +$command .= " -uri $output"; +$command .= " -path_base $outroot"; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " $cmdflags"; + +# Add the processed file to the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -addnormalizedimfile: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $iter and defined $class_id and not $no_update) { + my $command = "$dettool -addnormalizedimfile"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -class_id $class_id"; + $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Return the scheme used for a filename (copied from PS-IPP-Config/lib/PS/IPP/Config.pm +sub file_scheme +{ + my $name = shift; # Filename for which to get the scheme + my ($scheme) = $name =~ /^(path|neb|file):/; # The scheme, e.g., file://, path:// + # $scheme may be undef if the input doesn't contain one of the above recognised schemes + unless (defined($scheme)) { $scheme = "none"; } + return $scheme; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_calc.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_calc.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_calc.pl (revision 41105) @@ -0,0 +1,264 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run ); +use IPC::Run 0.36 qw( run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppNormCalc = can_run('ppNormCalc') or (warn "Can't find ppNormCalc" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse command-line arguments +my ($det_id, $iter, $det_type, $outroot, $dbname, $verbose, $no_update, $no_op, $redirect ); +GetOptions( + 'det_id|d=s' => \$det_id, # Detrend id + 'iteration|i=s' => \$iter, # Iteration + 'det_type|t=s' => \$det_type, # Detrend type + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do operations + 'redirect-output' => \$redirect, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options --det_id --iteration --det_type --outroot", + -exitval => 3, + ) unless + defined $det_id and + defined $iter and + defined $det_type and + defined $outroot; + +# force det_type to be upper-case in this script +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $det_id, $iter, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logfile = $outroot . ".log"; +$ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $det_id, $iter, $PS_EXIT_SYS_ERROR ) if $redirect; + +use constant STATISTIC => 'bg'; # Background statistic to use from the database + +# Define which detrend types we normalise +use constant NORMALIZE => { + 'BIAS' => 0, + 'DARK' => 0, + 'DARK_PREMASK' => 0, + 'SHUTTER' => 0, + 'FLAT_PREMASK' => 1, + 'DOMEFLAT_PREMASK' => 1, + 'SKYFLAT_PREMASK' => 1, + 'FLAT_RAW' => 1, + 'DOMEFLAT_RAW' => 1, + 'SKYFLAT_RAW' => 1, + 'SKYFLATTEST_RAW' => 1, + 'FLAT' => 1, + 'FLATTEST' => 1, + 'DOMEFLAT' => 1, + 'SKYFLAT' => 1, + 'FRINGE' => 0, + 'MASK' => 0, + 'DARKMASK' => 0, + 'FLATMASK' => 0, + 'CTEMASK' => 0, + 'DARKTEST' => 0, + 'NOISEMAP' => 0, + }; + +&my_die("Unrecognised detrend type: $det_type", $det_id, $iter, $PS_EXIT_PROG_ERROR) unless exists NORMALIZE()->{$det_type}; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Get the list of inputs +my @files; # The input files +{ + my $command = "$dettool -residimfile"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -included"; # only use the inputs for this detrend run to calculate the norm + $command .= " -dbname $dbname" if defined $dbname; + my @command = split /\s+/, $command; + my ( $stdin, $stdout, $stderr ); # Buffers for running program + print "Running [$command]...\n" if $verbose; + if (not run(\@command, \$stdin, \$stdout, \$stderr)) { + &my_die("Unable to perform dettool -residimfile on detrend $det_id/$iter: $?", + $det_id, $iter, $PS_EXIT_SYS_ERROR); + } + print $stdout . "\n" if $verbose; + + # Because of the length, need to split into individual metadatas --- it parses SO much quicker! + my @whole = split /\n/, $stdout; + my @single = (); + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ); + &my_die("Unable to parse output from dettool", $det_id, $iter, $PS_EXIT_PROG_ERROR) unless + defined $list; + push @files, @$list; + @single = (); + } + } +} + +my $norms; # MDC with normalisations +if (NORMALIZE()->{$det_type} and not $no_op) { + + my %matrix; # Matrix of statistics as a function of exposures and classes + foreach my $file (@files) { + my $exp_id = $file->{'exp_id'}; # Exposure ID + my $class_id = $file->{'class_id'}; # Class ID + my $stat = $file->{STATISTIC()}; # Statistic of interest + + # Create matrix elements + $matrix{$exp_id} = {} if not defined $matrix{$exp_id}; + $matrix{$exp_id}->{$class_id} = $stat; + } + + # Generate the input for ppNormCalc + my $normData; # Normalisation data + foreach my $exp_id (keys %matrix) { + $normData .= "$exp_id\tMETADATA\n"; + foreach my $class_id (keys %{$matrix{$exp_id}}) { + $normData .= "\t" . $class_id . "\tF32\t" . $matrix{$exp_id}->{$class_id} . "\n"; + } + $normData .= "END\n\n"; + } + + # Run ppNormCalc + { + my ( $stdout, $stderr ); # Buffers for running program + my @command = split /\s+/, $ppNormCalc; + print "Running [$ppNormCalc]...\n" if $verbose; + if (not run(\@command, \$normData, \$stdout, \$stderr)) { + &my_die("Unable to perform ppNormCalc: $?", $det_id, $iter, $PS_EXIT_SYS_ERROR); + } + print $stdout . "\n" if $verbose; + + # Parse the output + $norms = $mdcParser->parse($stdout); + &my_die("Unable to parse metadata config doc", $det_id, $iter, $PS_EXIT_PROG_ERROR) unless $norms; + } + +} else { + # It's something that doesn't need normalisation --- just push in a normalisation of 1 + my %classes; # List of unique classes + foreach my $file (@files) { + my $class_id = $file->{'class_id'}; # Class Id + $classes{$class_id} = 1; + } + + foreach my $class_id (keys %classes) { + my %mdValue; # Metadata value for this class id + $mdValue{name} = $class_id; + $mdValue{value} = 1.0; + push @$norms, \%mdValue; + } +} + +my $commandBase = "$dettool -addnormalizedstat"; +$commandBase .= " -det_id $det_id"; +$commandBase .= " -iteration $iter"; +$commandBase .= " -dbname $dbname" if defined $dbname; + +# Process output normalisations +unless ($no_update) { + foreach my $normItem (@$norms) { + + my $className = $normItem->{name}; # Name of component + my $normalisation = $normItem->{value}; # Normalisation for component + + if ($normalisation == 0.0 or lc($normalisation) eq 'nan') { + warn("Class $className has bad normalisation: $normalisation"); + # exit($PS_EXIT_SYS_ERROR); + } + + my $command = $commandBase; + $command .= " -class_id $className"; + $command .= " -norm $normalisation"; + + my @command = split /\s+/, $command; + + my ( $stdin, $stdout, $stderr ); # Buffers for running program + print "Running [$command]...\n" if $verbose; + if (not run \@command, \$stdin, \$stdout, \$stderr) { + warn("Unable to perform dettool -addnormstat for $className: $?"); + # exit($PS_EXIT_SYS_ERROR); + } + print $stdout . "\n" if $verbose; + } +} else { + print "skipping command: $commandBase\n"; + foreach my $normItem (@$norms) { + + my $className = $normItem->{name}; # Name of component + my $normalisation = $normItem->{value}; # Normalisation for component + + if ($normalisation == 0.0 or lc($normalisation) eq 'nan') { + warn("Class $className has bad normalisation: $normalisation"); + # exit($PS_EXIT_SYS_ERROR); + } + print "$className : $normalisation\n"; + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $iter and not $no_update) { + my $command = "$dettool -addnormalizedstat"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + # XXX EAM : we should add this to the db : $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_exp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_exp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_norm_exp.pl (revision 41105) @@ -0,0 +1,210 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); +use PS::IPP::Metadata::List qw( parse_md_list ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($det_id, $iter, $det_type, $camera, $outroot, $dbname, $reduction, $verbose, $no_update, $no_op, $redirect, $save_temps); +GetOptions( + 'det_id|d=s' => \$det_id, + 'iteration|i=s' => \$iter, + 'camera|c=s' => \$camera, + 'det_type|t=s' => \$det_type, + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction|=s' => \$reduction, + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --iteration --camera --det_type --outroot", + -exitval => 3) unless + defined $det_id and + defined $iter and + defined $camera and + defined $det_type and + defined $outroot; + +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $iter, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +my $logfile = $outroot . ".log"; +$ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $det_id, $iter, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use based on reduction class +$reduction = 'DETREND' unless defined $reduction; +my $recipe = $ipprc->reduction($reduction, uc($det_type) . '_JPEG_IMAGE'); +&my_die("Unrecognised detrend type: $det_type", $det_id, $iter, $PS_EXIT_PROG_ERROR) unless defined $recipe; + +# Get list of component files +my $cmdflags; +my ($files, $command, $success, $error_code, $full_buf, $stdout_buf, $stderr_buf); +{ + $command = "$dettool -normalizedimfile"; # Command to run + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to get list of normalized imfiles from dettool: $error_code", $det_id, $iter, $error_code); + } + # XXX report an error message if stdout_buf is empty + + # convert stdout to a metadata + my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $det_id, $iter, $PS_EXIT_PROG_ERROR); + + # parse the file info in the metadata + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $det_id, $iter, $PS_EXIT_PROG_ERROR); + + # since I can't figure out how to do input and output within PERL, I'm writing to a temp file + my ($statFile, $statName) = tempfile( "/tmp/$camera.$det_type.norm.$det_id.$iter.stats.XXXX", UNLINK => !$save_temps ); + foreach my $line (@$stdout_buf) { + print $statFile $line; + } + close $statFile; + + $command = "$ppStatsFromMetadata $statName - DETREND_NORM_EXP"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform ppStatsFromMetadata: $error_code\n"); + exit($error_code); + } + + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; +} + +my ($list1File, $list1Name) = tempfile( "/tmp/$camera.$det_type.norm.$det_id.$iter.b1.list.XXXX", UNLINK => !$save_temps ); +my ($list2File, $list2Name) = tempfile( "/tmp/$camera.$det_type.norm.$det_id.$iter.b2.list.XXXX", UNLINK => !$save_temps ); +foreach my $file (@$files) { + print $list1File ( $ipprc->filename( "PPIMAGE.BIN1", $file->{path_base}, $file->{class_id} ) . "\n"); + print $list2File ( $ipprc->filename( "PPIMAGE.BIN2", $file->{path_base}, $file->{class_id} ) . "\n"); +} +close $list1File; +close $list2File; + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +my $jpeg1Name = $ipprc->filename("PPIMAGE.JPEG1", $outroot); # Binned JPEG #1 +my $jpeg2Name = $ipprc->filename("PPIMAGE.JPEG2", $outroot); # Binned JPEG #2 + +unless ($no_op) { + # Make the jpeg for binning 1 + $command = "$ppImage -list $list1Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE PPIMAGE_J1"; + $command .= " -recipe JPEG $recipe"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die("Unable to find expected output file: $jpeg1Name", $det_id, $iter, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($jpeg1Name); + + # Make the jpeg for binning 2 + $command = "$ppImage -list $list2Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE PPIMAGE_J2"; + $command .= " -recipe JPEG $recipe"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die("Unable to find expected output file: $jpeg2Name", $det_id, $iter, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($jpeg2Name); + +} + +# command to update the database +$command = "$dettool -addnormalizedexp"; +$command .= " -det_id $det_id"; +$command .= " -iteration $iter"; +$command .= " -recip $recipe"; +$command .= " -path_base $outroot "; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " $cmdflags"; + +# Add the processed file to the database +unless ($no_update) { + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool -addnormalizedexp: $error_code", $det_id, $iter, $error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $iter and not $no_update) { + my $command = "$dettool -addnormalizedexp"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -path_base $outroot "; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_process_exp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_process_exp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_process_exp.pl (revision 41105) @@ -0,0 +1,225 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); +use PS::IPP::Metadata::List qw( parse_md_list ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $det_id, $exp_id, $det_type, $exp_tag, $camera, $outroot, $dbname, $reduction, $verbose, $no_update, + $no_op, $save_temps, $redirect ); +GetOptions( + 'det_id|d=s' => \$det_id, + 'det_type|t=s' => \$det_type, + 'exp_id|d=s' => \$exp_id, + 'exp_tag|=s' => \$exp_tag, + 'camera|c=s' => \$camera, + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction|=s' => \$reduction, + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'save-temps' => \$save_temps, # Save temporary files? + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --det_type --exp_id --exp_tag --camera --outroot", + -exitval => 3) unless + defined $det_id and + defined $det_type and + defined $exp_id and + defined $exp_tag and + defined $camera and + defined $outroot; + +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $exp_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +if ($redirect) { + my $logDest = $ipprc->filename("LOG.EXP", $outroot, "NONE") + or &my_die("Missing entry in file rules", $det_id, $exp_id, $PS_EXIT_CONFIG_ERROR); + $ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $det_id, $exp_id, $PS_EXIT_SYS_ERROR ); +} + +# Recipes to use based on reduction class +$reduction = 'DETREND' unless defined $reduction; + +my $recipe = $ipprc->reduction($reduction, uc($det_type) . '_JPEG_IMAGE'); # Recipe to use +&my_die("Unrecognised detrend type: $det_type", $det_id, $exp_id, $PS_EXIT_PROG_ERROR) unless defined $recipe; + +my $cmdflags; + +# Get list of component files +my ($files, $command, $success, $error_code, $full_buf, $stdout_buf, $stderr_buf); +{ + $command = "$dettool -processedimfile -det_id $det_id -exp_id $exp_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool -processedimfile: $error_code", $det_id, $exp_id, $error_code); + } + + # convert stdout to a metadata + my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $det_id, $exp_id, $PS_EXIT_PROG_ERROR); + + # parse the file info in the metadata + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $det_id, $exp_id, $PS_EXIT_PROG_ERROR); + + # since I can't figure out how to do input and output within PERL, I'm writing to a temp file + my ($statFile, $statName) = tempfile( "/tmp/$exp_tag.detproc.$det_id.stats.XXXX", UNLINK => !$save_temps ); + print "saving stats to $statName\n"; + foreach my $line (@$stdout_buf) { + print $statFile $line; + } + close $statFile; + + # parse the stats in the metadata file + $command = "$ppStatsFromMetadata $statName - DETREND_PROCESS_EXP"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform ppStatsFromMetadata: $error_code\n"); + exit($error_code); + } + + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; +} + +# File lists for the two binnings +my ($list1File, $list1Name) = tempfile( "/tmp/$exp_tag.detproc.$det_id.b1.list.XXXX", UNLINK => !$save_temps ); +my ($list2File, $list2Name) = tempfile( "/tmp/$exp_tag.detproc.$det_id.b2.list.XXXX", UNLINK => !$save_temps ); +foreach my $file (@$files) { + print $list1File ($ipprc->filename( "PPIMAGE.BIN1", $file->{path_base}, $file->{class_id} ) . "\n"); + print $list2File ($ipprc->filename( "PPIMAGE.BIN2", $file->{path_base}, $file->{class_id} ) . "\n"); +} +close $list1File; +close $list2File; + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +my $jpeg1 = $ipprc->filename("PPIMAGE.JPEG1", $outroot); # Binned JPEG #1 +my $jpeg2 = $ipprc->filename("PPIMAGE.JPEG2", $outroot); # Binned JPEG #2 + +unless ($no_op) { + # Make the jpeg for binning 1 + $command = "$ppImage -list $list1Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE PPIMAGE_J1"; + $command .= " -recipe JPEG $recipe"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $det_id, $exp_id, $error_code); + } + &my_die("Unable to find expected output file: $jpeg1", $det_id, $exp_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($jpeg1); + + # Make the jpeg for binning 2 + $command = "$ppImage -list $list2Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE PPIMAGE_J2"; + $command .= " -recipe JPEG $recipe"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $det_id, $exp_id, $error_code); + } + &my_die("Unable to find expected output file: $jpeg2", $det_id, $exp_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($jpeg2); +} + +# Command to update the database +$command = "$dettool -addprocessedexp"; +$command .= " -det_id $det_id"; +$command .= " -exp_id $exp_id"; +$command .= " -recip $recipe -path_base $outroot"; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " $cmdflags"; + +# Add the processed file to the database +unless ($no_update) { + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -addprocessedexp: $error_code"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $exp_id = shift; # Exposure tag + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $exp_id and not $no_update) { + my $command = "$dettool -addprocessedexp"; + $command .= " -det_id $det_id"; + $command .= " -exp_id $exp_id"; + $command .= " -fault $exit_code"; + $command .= " -path_base $outroot"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_process_imfile.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_process_imfile.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_process_imfile.pl (revision 41105) @@ -0,0 +1,230 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $nebrepair = can_run('neb-repair') or (warn "Can't find neb-repair" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $det_id, $exp_id, $class_id, $det_type, $exp_tag, $input_uri, $camera, $outroot, $dbname, $reduction, + $threads, $verbose, $no_update, $no_op, $redirect ); +GetOptions( + 'det_id|d=s' => \$det_id, + 'exp_id|e=s' => \$exp_id, + 'class_id|i=s' => \$class_id, + 'det_type|t=s' => \$det_type, + 'exp_tag|=s' => \$exp_tag, + 'input_uri|u=s' => \$input_uri, + 'camera|c=s' => \$camera, + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'threads=s' => \$threads, # Number of threads to use for ppImage + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --exp_id --class_id --det_type --exp_tag --input_uri --camera --outroot", + -exitval => 3) unless + defined $det_id and + defined $exp_id and + defined $class_id and + defined $det_type and + defined $exp_tag and + defined $input_uri and + defined $camera and + defined $outroot; + +# force det_type to be upper-case in this script +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $exp_id, $class_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +my $logDest = $ipprc->filename("LOG.IMFILE", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $exp_id, $class_id, $PS_EXIT_CONFIG_ERROR); +$ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $det_id, $exp_id, $class_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use as a function of detrend type +$reduction = "DETREND" unless defined $reduction; +my $ppimage_recipe = $ipprc->reduction($reduction, $det_type . '_PROCESS'); # Recipe name for ppImage +my $jpeg_recipe = $ipprc->reduction($reduction, $det_type . '_JPEG_IMAGE'); # Recipe name for JPEG + +# The output file rule name depends on the detrend type +my $FILERULES = { 'FLATMASK' => undef, + 'DARKMASK' => undef, + 'MASK' => undef, + 'BIAS' => undef, + 'DARK' => undef, + 'DARK_PREMASK' => undef, + 'DARKTEST' => undef, + 'CTEMASK' => undef, + 'NOISEMAP' => undef, + 'SHUTTER' => 'PPIMAGE.OUTPUT.DETREND', + 'FLAT_PREMASK' => 'PPIMAGE.OUTPUT.DETREND', + 'DOMEFLAT_PREMASK' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLAT_PREMASK' => 'PPIMAGE.OUTPUT.DETREND', + 'FLAT_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'DOMEFLAT_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLAT_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLATTEST_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'FLAT' => 'PPIMAGE.OUTPUT.DETREND', + 'FLATTEST' => 'PPIMAGE.OUTPUT.DETREND', + 'DOMEFLAT' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLAT' => 'PPIMAGE.OUTPUT.DETREND', + 'FRINGE' => 'PPIMAGE.OUTPUT.DETREND', + }; + +&my_die("Couldn't find input file: $input_uri\n", $det_id, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($input_uri); + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +my $cmdflags; + +my $filerule = $FILERULES->{$det_type}; # File rule to use for output +$filerule = "PPIMAGE.OUTPUT" unless defined $filerule; + +my $outputImage = $ipprc->filename($filerule, $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $exp_id, $class_id, $PS_EXIT_PROG_ERROR); +my $outputBin1 = $ipprc->filename("PPIMAGE.BIN1", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $exp_id, $class_id, $PS_EXIT_PROG_ERROR); +my $outputBin2 = $ipprc->filename("PPIMAGE.BIN2", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $exp_id, $class_id, $PS_EXIT_PROG_ERROR); +my $outputStats = $ipprc->filename("PPIMAGE.STATS", $outroot, $class_id) or &my_die("Missing entry from camera config", $det_id, $exp_id, $class_id, $PS_EXIT_PROG_ERROR); +my $traceDest = $ipprc->filename("TRACE.IMFILE", $outroot, $class_id) or &my_die("Missing entry from camera config", $exp_id, $exp_id, $class_id, $PS_EXIT_CONFIG_ERROR); + + +# Run ppImage +unless ($no_op) { + if ($input_uri =~ /neb/) { + my $repair_cmd = "$nebrepair $input_uri"; + my ($repair_success, $repair_error_code, $repair_full_buf, $repair_stdout_buf, $repair_stderr_buf ) = run(command => $repair_cmd, verbose => $verbose); + unless ($repair_success) { + &my_die("Unable to attempt repair: $input_uri $repair_error_code", $det_id, $exp_id, $class_id, $PS_EXIT_SYS_ERROR); + } + } + + + my $command = "$ppImage -file $input_uri $outroot"; + $command .= " -recipe PPIMAGE $ppimage_recipe"; + $command .= " -recipe JPEG $jpeg_recipe"; + $command .= " -recipe PPSTATS DETSTATS"; + $command .= " -stats $outputStats"; + $command .= " -F PPIMAGE.OUTPUT $filerule" if $filerule ne "PPIMAGE.OUTPUT"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -threads $threads" if defined $threads; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $det_id, $exp_id, $class_id, $error_code); + } + + &my_die("Couldn't find expected output file: $outputImage", $det_id, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputImage); + &my_die("Couldn't find expected output file: $outputBin1", $det_id, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputBin1); + &my_die("Couldn't find expected output file: $outputBin2", $det_id, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputBin2); + + my $outputStatsReal = $ipprc->file_resolve($outputStats); + &my_die("Couldn't find expected output file: $outputStats", $det_id, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + # parse stats from metadata + $command = "$ppStatsFromMetadata $outputStatsReal - DETREND_PROCESS_IMFILE"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $det_id, $exp_id, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; +} + +# command to update database +my $command = "$dettool -addprocessedimfile"; +$command .= " -det_id $det_id"; +$command .= " -exp_id $exp_id"; +$command .= " -class_id $class_id"; +$command .= " -recip $reduction"; +$command .= " -uri $outputImage -path_base $outroot"; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " $cmdflags"; + +# Add the processed file to the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -addprocessedimfile: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $exp_id = shift; # Exposure tag + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $exp_id and defined $class_id and not $no_update) { + my $command = "$dettool -addprocessedimfile"; + $command .= " -det_id $det_id"; + $command .= " -exp_id $exp_id"; + $command .= " -class_id $class_id"; + $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_reject_exp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_reject_exp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_reject_exp.pl (revision 41105) @@ -0,0 +1,372 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::Stats; +use PS::IPP::Config 1.01 qw( :standard ); +use PS::IPP::Metadata::List qw( parse_md_list ); +use Statistics::Descriptive; + +my $ITER_LIMIT = 20; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($det_id, $iter, $det_type, $camera, $outroot, $filter, $dbname, $verbose, $no_update, $no_op, $redirect); +GetOptions( + 'det_id|d=s' => \$det_id, + 'iteration=s' => \$iter, + 'det_type|t=s' => \$det_type, + 'camera=s' => \$camera, + 'outroot|w=s' => \$outroot, # output file base name + 'filter=s' => \$filter, + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --iteration --det_type --camera --outroot", + -exitval => 3) unless + defined $det_id and + defined $iter and + defined $det_type and + defined $camera and + defined $outroot; + +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $det_id, $iter, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$ipprc->outroot_prepare($outroot) or my_die( "Unable to prepare output root", $det_id, $iter, $PS_EXIT_SYS_ERROR ); +my $logName = "$outroot.log"; # Name for log +$ipprc->redirect_output($logName) or my_die( "Unable to redirect", $det_id, $iter, $PS_EXIT_SYS_ERROR ) if $redirect; + +# values to extract from output metadata and the stats to calculate +# XXX -bg_mean_stdev should take rms of bg_mean_stdev if bg_mean_stdev != 0 (A) +# XXX -bg_mean_stdev should take stdev of bg_mean if bg_mean_stdev == 0 (B) +# XXX (A) if imfile.Ncomp > 1, (B) if imfile.Ncomp == 1 +my $STATS = + [ + # KEYWORD STATISTIC CHIPTOOL FLAG + { name => "bg", type => "mean", flag => "-bg", dtype => "float" }, + { name => "bg_mean_stdev", type => "stdev", flag => "-bg_mean_stdev", dtype => "float" }, + { name => "bg_stdev", type => "rms", flag => "-bg_stdev", dtype => "float" }, + ]; +my $stats = PS::IPP::Metadata::Stats->new($STATS); # Stats parser + +# these stats are used it the rejections but not passed to the database +# there is some duplication with the above, but the calculation time is minimal +my $REJSTATS = + [ + # KEYWORD STATISTIC CHIPTOOL FLAG + { name => "bg", type => "clipmean", flag => "ensMeanMean", dtype => "float" }, + { name => "bg", type => "clipstdev", flag => "ensMeanStdev", dtype => "float" }, + { name => "bg_mean_stdev", type => "clipmean", flag => "ensMeanStdevMean", dtype => "float" }, + { name => "bg_mean_stdev", type => "clipstdev", flag => "ensMeanStdevStdev", dtype => "float" }, + { name => "bg_stdev", type => "clipmean", flag => "ensStdevMean", dtype => "float" }, + { name => "bg_stdev", type => "clipstdev", flag => "ensStdevStdev", dtype => "float" }, + { name => "bg_skewness", type => "clipmean", flag => "ensSkewness", dtype => "float" }, + { name => "bg_kurtosis", type => "clipmean", flag => "ensKurtosis", dtype => "float" }, + + ]; +my $rejstats = PS::IPP::Metadata::Stats->new($REJSTATS); # Stats parser + +# Get list of component files +my ($exposures, $command, $success, $error_code, $full_buf, $stdout_buf, $stderr_buf); +{ + # dettool command to select exp data for this det_run + $command = "$dettool -residexp"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool -residexp: $error_code", $det_id, $iter, $error_code); + } + + # Parse the stdout buffer into a metadata + my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $det_id, $iter, $PS_EXIT_PROG_ERROR); + + # parse the file info in the metadata + $exposures = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $det_id, $iter, $PS_EXIT_PROG_ERROR); + + # Parse the statistics on the residual image + $stats->parse($metadata) or &my_die("Unable to find all values in statistics output.", $det_id, $iter, $PS_EXIT_PROG_ERROR); + + # Parse the statistics for rejections + $rejstats->parse($metadata) or &my_die("Unable to find all values in statistics output.", $det_id, $iter, $PS_EXIT_PROG_ERROR); +} + +# each image has a mean mean (average of means over all chips) +# a standard deviation mean (average of standard deviations over all chips) +# and a + + + +# we use the statistics of the ensemble to accept/reject exposurs +my $ensMeanMean = $rejstats->value_for_flag ("ensMeanMean"); # average of all exposure means (in turn averaged over all chips) +my $ensMeanStdev = $rejstats->value_for_flag ("ensMeanStdev"); # standard deviation of all exposure means +my $ensMeanStdevMean = $rejstats->value_for_flag ("ensMeanStdevMean"); # average over all exposures of the stdev of the means for each chip +my $ensMeanStdevStdev = $rejstats->value_for_flag ("ensMeanStdevStdev"); # standard deviation over all exposures of the stdev of the means for each chip +my $ensStdevMean = $rejstats->value_for_flag ("ensStdevMean"); # average over all exposures of the sum of the squares of the stdevs for each chip +my $ensStdevStdev = $rejstats->value_for_flag ("ensStdevStdev"); # standard deviation over all exposures of the sum of the squares of the stdevs for each chip + +$ipprc->define_camera($camera); +# Rejection thresholds +my $reject_mean = rejection_limit( 'ENSEMBLE.MEAN', $det_type, $filter ); +my $reject_stdev = rejection_limit( 'ENSEMBLE.STDEV', $det_type, $filter ); +my $reject_meanstdev = rejection_limit( 'ENSEMBLE.MEANSTDEV', $det_type, $filter ); + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +unless ($no_op) { + print "Ensemble mean $ensMeanMean +/- $ensMeanStdev\n"; + print "Ensemble stdev $ensStdevMean +/- $ensStdevStdev\n"; + print "Ensemble mean rms (over imfiles) $ensMeanStdevMean +/- $ensMeanStdevStdev\n\n"; +} + +# Go through again to do rejection, and update the database for each exposure +my $numChanges = 0; # Number of exposures with changed status +my $numReject = 0; # Number of exposures rejected +my $firstElement = 1; + +foreach my $exposure (@$exposures) { + my $mean = $exposure->{bg}; # Mean for this exposure + my $stdev = $exposure->{bg_stdev}; # Stdev for this exposure + my $meanStdev = $exposure->{bg_mean_stdev}; # Stdev of Means for this exposure + my $expID = $exposure->{exp_id}; + my $accept = $exposure->{accept}; + my $include = $exposure->{include}; + + &my_die("Unable to find exposure id.\n", $det_id, $iter, $PS_EXIT_SYS_ERROR) unless defined $expID; + &my_die("Unable to find accept.\n", $det_id, $iter, $PS_EXIT_SYS_ERROR) unless defined $accept; + &my_die("Unable to find include.\n", $det_id, $iter, $PS_EXIT_SYS_ERROR) unless defined $include; + + my $reject = 0; # Reject this exposure? + + $command = "$dettool -updateresidexp"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -exp_id $expID"; + $command .= " -dbname $dbname" if defined $dbname; + + if (not $accept) { + # Rejected this at an earlier stage + unless ($no_op) { + print "Rejecting $expID based on earlier determination.\n"; + } + $reject = 1; + goto UPDATE; + } + + # Cop-out if we're not doing any operations + if ($no_op) { + # Make sure something gets rejected (just once!), just so that + # we can trace the full range of the workflow + if ($firstElement and $iter == 0) { + $reject = 1; + } + goto UPDATE; + } + + if ($reject_mean > 0 and $ensMeanStdev > 0) { + my $delta = abs($mean - $ensMeanMean); + if ($delta > ($reject_mean * $ensMeanStdev)) { + print "Rejecting $expID based on ensemble mean value: "; + $reject = 1; + #goto UPDATE; + } else { + print "$expID OK against ensemble mean: "; + } + print "$mean --> $delta vs " . $reject_mean * $ensMeanStdev . "\n"; + } else { + print "No rejection of $expID for ensemble mean\n"; + } + + if ($reject_stdev > 0 and $ensStdevStdev > 0) { + my $delta = abs($stdev - $ensStdevMean); + if ($delta > ($reject_stdev * $ensStdevStdev)) { + print "Rejecting $expID based on ensemble stdev: "; + $reject = 1; + #goto UPDATE; + } else { + print "$expID OK against ensemble stdev: "; + } + print "$stdev --> $delta sigma vs " . $reject_stdev * $ensStdevStdev . "\n"; + } else { + print "No rejection of $expID for ensemble stdev\n"; + } + + if ($reject_meanstdev > 0 and $ensMeanStdevStdev > 0) { + my $delta = abs($meanStdev - $ensMeanStdevMean); + if ($delta > ($reject_meanstdev * $ensMeanStdevStdev)) { + print "Rejecting $expID based on ensemble mean stdev: "; + $reject = 1; + #goto UPDATE; + } else { + print "$expID OK against ensemble mean stdev: "; + } + print "$meanStdev --> $delta sigma vs " . $reject_meanstdev * $ensMeanStdevStdev. "\n"; + } else { + print "No rejection of $expID for ensemble mean stdev\n"; + } + + UPDATE: + if ($reject) { + $command .= ' -reject'; + $numReject++; + } + + # Check for status changes + if ((not $include and not $reject) or ($include and $reject)) { + unless ($no_op) { + print "Status of $expID has changed.\n"; + } + $numChanges++; + } + + unless ($no_update) { + # Update + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool -updateresidexp: $error_code", $det_id, $iter, $error_code); + } + } +} + +# Decide if the current is sufficient to use as a master, and if we can stop iterating +my $master = 1; # This is good enough for a master +my $stop = 1; # Stop iterating + +if ($numChanges > 0) { + $master = 0; + $stop = 0; +} + +# Rejecting everything --- stop before something bad happens! +if ($numReject == scalar @$exposures) { + $master = 0; + $stop = 1; + carp "All inputs rejected!\n"; +} + +unless ($no_op) { + print "Master: $master\n"; + print "Stop: $stop\n"; +} + +# Allow iteration to be turned off +my $allow_iter = metadataLookupBool($ipprc->{rejection}, "ITERATION"); # Allow iteration? +my $force_master = metadataLookupBool($ipprc->{rejection}, "MASTER"); # Force the stack to be accepted +$stop = 1 unless $allow_iter; +$master = 1 if $force_master and $stop; + +# attempt to prevent endless, pathological iterations +if ($iter >= $ITER_LIMIT) { + warn("iteration limit reached -- bailing out"); + exit($PS_EXIT_PROG_ERROR); +} + +## add the summary statistics, and request a new iteration if needed +$command = "$dettool -adddetrunsummary"; +$command .= " -det_id $det_id"; +$command .= " -iteration $iter"; +$command .= " -accept" if $master; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " -again" unless $stop; +$command .= $stats->cmdflags(); + +# Put results into the database +unless ($no_update) { + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -adddetrunsummary: $error_code"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $iter and not $no_update) { + my $command = "$dettool -adddetrunsummary"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + # XXX EAM : we should add this to the db : $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Retrieve the requested rejection limit, dying unless extant +sub rejection_limit +{ + my $name = shift; # Rejection limit to + my $type = shift; # Type of exposure + my $filter = shift; # Filter + + my $value = $ipprc->rejection( $name, $det_type, $filter ); + if (not defined $value) { + $filter = "(no filter)" unless defined $filter; + die "Unable to determine $name rejection limit for $det_type with $filter.\n"; + } + + return $value; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_resid_exp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_resid_exp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_resid_exp.pl (revision 41105) @@ -0,0 +1,712 @@ +#!/usr/bin/env perl + +# this program has two jobs: +# 1: for the given exp_tag, generate the binned & mosaiced JPEG images +# 2: examine the collection of per-imfile statistics and reject. At the moment, +# this program (and the database) only allows rejection at the exposure level, +# not at the imfile level. + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +print "\n\n"; +print "Starting script $0 on $host\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); # tools to run UNIX programs with control over I/O +# use IPC::Run qw ( start finish timeout ); +use IPC::Run; + +use PS::IPP::Metadata::Config; # tools to parse the psMetadataConfig files + +use PS::IPP::Metadata::List qw( parse_md_list ); # tools to parse a metadata into a hash list +use Statistics::Descriptive; # tools for calculating basic statistical quantities +use File::Temp qw( tempfile ); # tools to construct temp files +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); # option parsing +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# parse the command-line options +my ( $det_id, $iter, $exp_id, $exp_tag, $det_mode, $det_type, $camera, $filter, $reject, $outroot, $dbname, $reduction, + $verbose, $no_update, $no_op, $save_temps, $redirect ); +GetOptions( + 'det_id|d=s' => \$det_id, + 'iteration=s' => \$iter, + 'exp_id|e=s' => \$exp_id, + 'exp_tag|=s' => \$exp_tag, + 'det_type|t=s' => \$det_type, + 'det_mode=s' => \$det_mode, + 'camera=s' => \$camera, + 'outroot|w=s' => \$outroot, # output file base name + 'filter=s' => \$filter, + 'reject' => \$reject, + 'dbname|d=s' => \$dbname, # Database name + 'reduction|=s' => \$reduction, + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'save-temps' => \$save_temps, # Save temporary files? + 'redirect-output' => \$redirect, # redirect output to LOG.EXP + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --iteration --exp_id --exp_tag --det_type --camera --outroot", + -exitval => 3) unless + defined $det_id and + defined $iter and + defined $exp_id and + defined $exp_tag and + defined $det_type and + defined $det_mode and + defined $camera and + defined $outroot; + +# force det_type to be upper-case in this script +$det_type = uc($det_type); + +# load IPP config information for the specified camera +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $iter, $exp_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +my $logDest = $ipprc->filename("LOG.EXP", $outroot) or &my_die("Missing entry from camera config", $det_id, $iter, $exp_id, $PS_EXIT_CONFIG_ERROR); +$ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $det_id, $iter, $exp_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use based on reduction class +$reduction = 'DETREND' unless defined $reduction; + +my $recipe = $ipprc->reduction($reduction, $det_type . '_JPEG_RESID'); # Recipe to use +&my_die("Unrecognised detrend type: $det_type", $det_id, $iter, $PS_EXIT_PROG_ERROR) unless defined $recipe; + +# variables used for I/O +my ($command, $success, $error_code, $full_buf, $stdout_buf, $stderr_buf); + +# Get list of normalizations by class_id : stored as $norms; save to temp file for ppImage runs below +my (%norms, $normsName); +if ($det_mode eq 'master') { + # dettool command to select imfile data for this exp_id + $command = "$dettool -normalizedstat"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -residimfile: $error_code\n"); + exit($error_code); + } + if (@$stdout_buf == 0) { + &my_die("No normalizations were found", $det_id, $iter, $PS_EXIT_PROG_ERROR); + } + + # Parse the stdout buffer into a metadata + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $det_id, $iter, $exp_id, $PS_EXIT_PROG_ERROR); + + # parse the file info in the metadata + my $normsMD = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $det_id, $iter, $exp_id, $PS_EXIT_PROG_ERROR); + + + # write the normalizations to a file as a metadata config file in the form: class_id F32 value + # XXX a possible optimization: if there is only one imfile, skip normalization + # Correcting the resid imfiles and stats requires us to *divide* by the normalization + # we do this by inverting the normalization here: + my $normsFile; + ($normsFile, $normsName) = tempfile( "/tmp/$exp_tag.detresid.$det_id.$iter.norms.XXXX", UNLINK => !$save_temps ); + print "saving norms to $normsName\n"; + foreach my $norm (@$normsMD) { + my $class_id = $norm->{class_id}; + my $normalization = 1.0 / $norm->{norm}; + + $norms{$class_id} = $normalization; + printf $normsFile "$class_id F32 $normalization\n", + } + close $normsFile; +} + +# Get list of imfile files +my $cmdflags; +my (@files); +{ + # dettool command to select imfile data for this exp_id + $command = "$dettool -residimfile"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -exp_id $exp_id"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -residimfile: $error_code\n"); + exit($error_code); + } + if (@$stdout_buf == 0) { + &my_die("No imfiles were found", $det_id, $iter, $PS_EXIT_PROG_ERROR); + } + + # Parse the stdout buffer into a metadata + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $det_id, $iter, $exp_id, $PS_EXIT_PROG_ERROR); + + # since I can't figure out how to do input and output within PERL, I'm writing the (modified) metadata to a temp file + my ($statFile, $statName) = tempfile( "/tmp/$exp_tag.detresid.$det_id.$iter.stats.XXXX", UNLINK => !$save_temps ); + + print $statFile "rawResidImfile MULTI\n"; + + # parse the file info in the metadata + # as we parse the list of files and their stats, apply the normalization to the relevant fields + # also, write out the modified metadata set + foreach my $mdItem (@$metadata) { + if ($mdItem->{class} ne "metadata") { + carp "MD element ", $mdItem->{name}, " isn't of type METADATA --- ignored.\n"; + next; + } + my %hash; # Hash element + my $mdComponents = $mdItem->{value}; # Components of the metadata + + # determine the class_id for this block: + my $class_id; + foreach my $data (@$mdComponents) { + unless ($data->{name} eq "class_id") { next; } + $class_id = $data->{value}; + last; + } + + # a new metadata block + print $statFile "rawResidImfile METADATA\n"; + + # modify and save the data in this block: + foreach my $data (@$mdComponents) { + my $norm = 1.0; + if ($det_mode eq "master") { + $norm = $norms{$class_id}; + } + + # fields to modify by the normalization: + if ($data->{name} eq "bg") { $data->{value} *= $norm; } + if ($data->{name} eq "bg_stdev") { $data->{value} *= $norm; } + if ($data->{name} eq "bg_mean_stdev") { $data->{value} *= $norm; } + if ($data->{name} eq "bg_skewness") { $data->{value} *= $norm; } + if ($data->{name} eq "bg_kurtosis") { $data->{value} *= $norm; } + if ($data->{name} eq "bin_stdev") { $data->{value} *= $norm; } + + # write out the metadata, save on the array of hashes + print $statFile " $data->{name} $data->{type} $data->{value}\n"; + $hash{$data->{name}} = $data->{value}; + } + print $statFile "END\n"; + push @files, \%hash; + } + close $statFile; + + # parse the stats in the metadata file + $command = "$ppStatsFromMetadata $statName - DETREND_RESID_EXP"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform ppStatsFromMetadata: $error_code\n"); + exit($error_code); + } + + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; +} + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +my $jpeg1Name = $ipprc->filename("PPIMAGE.JPEG1", $outroot); # Binned JPEG #1 +my $jpeg2Name = $ipprc->filename("PPIMAGE.JPEG2", $outroot); # Binned JPEG #2 + +# XXX in debug mode, unlink = 0 +my ($list1File, $list1Name) = tempfile( "/tmp/$exp_tag.detresid.$det_id.$iter.b1.list.XXXX", UNLINK => !$save_temps ); +my ($list2File, $list2Name) = tempfile( "/tmp/$exp_tag.detresid.$det_id.$iter.b2.list.XXXX", UNLINK => !$save_temps ); +foreach my $file (@files) { + print $list1File ($ipprc->filename( "PPIMAGE.BIN1", $file->{path_base}, $file->{class_id} ) . "\n"); + print $list2File ($ipprc->filename( "PPIMAGE.BIN2", $file->{path_base}, $file->{class_id} ) . "\n"); +} +close $list1File; +close $list2File; + + +# build the JPEG images +unless ($no_op) { + # Make the jpeg for binning 1 + # XXX EAM : supply the collection of normalizations as a metadata + $command = "$ppImage -list $list1Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE PPIMAGE_J1"; + $command .= " -recipe JPEG $recipe"; + $command .= " -normlist $normsName" if defined $normsName; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run ppImage: $error_code", $det_id, $iter, $exp_id, $error_code); + } + &my_die("Unable to find expected output file: $jpeg1Name", $det_id, $iter, $exp_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($jpeg1Name); + + # Make the jpeg for binning 2 + # XXX EAM : supply the collection of normalizations as a metadata + $command = "$ppImage -list $list2Name $outroot"; # Command to run + $command .= " -recipe PPIMAGE PPIMAGE_J2"; + $command .= " -recipe JPEG $recipe"; + $command .= " -normlist $normsName" if defined $normsName; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run ppImage: $error_code", $det_id, $iter, $exp_id, $error_code); + } + &my_die("Unable to find expected output file: $jpeg2Name", $det_id, $iter, $exp_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($jpeg2Name); +} + +#### measure stats and reject if needed #### + +# Rejection thresholds & related data +my $expected = rejection_limit( 'EXPECTED', $det_type, $filter ); +my $reject_imfile_mean = rejection_limit( 'IMFILE.MEAN', $det_type, $filter ); +my $reject_imfile_flux = rejection_limit( 'IMFILE.FLUX', $det_type, $filter ); +my $reject_imfile_stdev = rejection_limit( 'IMFILE.STDEV', $det_type, $filter ); +my $reject_imfile_skewness = rejection_limit( 'IMFILE.SKEWNESS', $det_type, $filter ); +my $reject_imfile_kurtosis = rejection_limit( 'IMFILE.KURTOSIS', $det_type, $filter ); +my $reject_imfile_meanstdev = rejection_limit( 'IMFILE.MEANSTDEV', $det_type, $filter ); +my $reject_imfile_snr = rejection_limit( 'IMFILE.SNR', $det_type, $filter ); +my $reject_imfile_bin_stdev = rejection_limit( 'IMFILE.BIN.STDEV', $det_type, $filter ); +my $reject_imfile_bin_snr = rejection_limit( 'IMFILE.BIN.SNR', $det_type, $filter ); +my $reject_exp_mean = rejection_limit( 'EXP.MEAN', $det_type, $filter ); +my $reject_exp_flux = rejection_limit( 'EXP.FLUX', $det_type, $filter ); +my $reject_exp_stdev = rejection_limit( 'EXP.STDEV', $det_type, $filter ); +my $reject_exp_meanstdev = rejection_limit( 'EXP.MEANSTDEV', $det_type, $filter ); +my $reject_exp_snr = rejection_limit( 'EXP.SNR', $det_type, $filter ); +my $reject_exp_bin_stdev = rejection_limit( 'EXP.BIN.STDEV', $det_type, $filter ); +my $reject_exp_bin_snr = rejection_limit( 'EXP.BIN.SNR', $det_type, $filter ); + +# storage array +my @fluxes; + +foreach my $file (@files) { + my $name = $file->{class_id}; + my $mean = $file->{bg}; # Mean for this imfile + my $stdev = $file->{bg_stdev}; # Stdev for this imfile + my $skewness = $file->{bg_skewness}; # Skewness for this imfile + my $kurtosis = $file->{bg_kurtosis}; # Kurtosis for this imfile + my $meanStdev = $file->{bg_mean_stdev}; # Stdev of Means for this imfile + my $binStdev = $file->{bin_stdev}; # Binned Stdev for this imfile + + # calculate and save the fluxes + my $flux; + if ($file->{exp_time} == 0.0) { + $flux = $mean; + } else { + $flux = $mean / $file->{exp_time}; + } + push @fluxes, $flux; + + $mean -= $expected; + + last if $no_op; + + # reject exposure if, for any imfiles, the mean residual counts + # deviate from the expected value by more than N sigma, (sigma = + # total pixel variance). this test is sensible for images which + # should have a predictable nominal residual mean count value (eg, + # 0.0 for a bias). in general, use with ADDITIVE components + if ($reject_imfile_mean > 0) { + if (abs($mean) > $reject_imfile_mean * $stdev) { + print "Rejecting exposure based on bad imfile mean for $name: "; + $reject = 1; + } else { + print "Imfile mean for $name meets requirements: "; + } + print "$mean vs $reject_imfile_mean * $stdev\n"; + } else { + print "No rejection on imfile mean for $name\n"; + } + + # reject exposure if, for any imfiles, the mean residual flux + # deviates from the expected value by more than N sigma, (sigma = + # total pixel variance). this test is sensible for images which + # should have a predictable nominal residual flux value (eg, 0.0 + # for a bias). in general, use with ADDITIVE components + if ($reject_imfile_flux > 0) { + if (abs($flux) > $reject_imfile_flux) { + print "Rejecting exposure based on bad imfile flux for $name: "; + $reject = 1; + } else { + print "Imfile flux for $name meets requirements: "; + } + print "$flux vs $reject_imfile_flux\n"; + } else { + print "No rejection on imfile flux for $name\n"; + } + + # reject exposure if, for any imfiles, the total pixel variance is + # larger than the limit + if ($reject_imfile_stdev > 0) { + if ($stdev > $reject_imfile_stdev) { + print "Rejecting exposure based on bad imfile stdev for $name: "; + $reject = 1; + } else { + print "Imfile stdev for $name meets requirements: "; + } + print "$stdev vs $reject_imfile_stdev\n"; + + } else { + print "No rejection on imfile stdev for $name\n"; + } + + # reject exposure if, for any imfiles, the skewness is + # larger than the limit + if ($reject_imfile_skewness > 0) { + if ($stdev > $reject_imfile_skewness) { + print "Rejecting exposure based on bad imfile skewness for $name: "; + $reject = 1; + } else { + print "Imfile skewness for $name meets requirements: "; + } + print "$skewness vs $reject_imfile_skewness\n"; + + } else { + print "No rejection on imfile skewness for $name\n"; + } + + # reject exposure if, for any imfiles, the kurtosis is + # larger than the limit + if ($reject_imfile_kurtosis > 0) { + if ($stdev > $reject_imfile_kurtosis) { + print "Rejecting exposure based on bad imfile kurtosis for $name: "; + $reject = 1; + } else { + print "Imfile kurtosis for $name meets requirements: "; + } + print "$kurtosis vs $reject_imfile_kurtosis\n"; + + } else { + print "No rejection on imfile kurtosis for $name\n"; + } + + # reject exposure if, for any imfiles, the variance of the imfile + # component means is larger than the limit + if ($reject_imfile_meanstdev > 0) { + if ($meanStdev > $reject_imfile_meanstdev) { + print "Rejecting exposure based on bad imfile mean stdev for $name: "; + $reject = 1; + } else { + print "Imfile mean stdev for $name meets requirements: "; + } + print "$meanStdev vs $reject_imfile_meanstdev\n"; + } else { + print "No rejection on imfile mean stdev for $name\n"; + } + + # reject exposure if, for any imfiles, the signal-to-noise (ie, + # the mean counts / total pixel variance) of the imfile component + # means are less than the limit. this test is sensible for images + # which have finite residual flux such as a flat-field image. + if ($reject_imfile_snr > 0) { + if ($mean < $stdev * $reject_imfile_snr) { + print "Rejecting exposure based on bad imfile S/N for $name: "; + $reject = 1; + } else { + print "Imfile S/N for $name meets requirements: "; + } + print "mean: $mean vs stdev*SNlimit: " . $stdev * $reject_imfile_snr . "\n"; + } else { + print "No rejection on imfile S/N for $name\n"; + } + + # reject exposure if, for any imfiles, the signal-to-noise of the + # imfile component means, based on the stdev of the binned image + # is less than the limit. this test is sensible for images which + # have finite residual flux such as a flat-field image. + if ($reject_imfile_bin_stdev > 0) { + if ($binStdev > $reject_imfile_bin_stdev) { + print "Rejecting exposure based on bad imfile binned stdev for $name: "; + $reject = 1; + } else { + print "Imfile binned stdev for $name meets requirements: "; + } + print "$binStdev vs $reject_imfile_bin_stdev\n"; + } else { + print "No rejection on imfile binned stdev for $name\n"; + } + if ($reject_imfile_bin_snr > 0) { + if ($mean < $binStdev * $reject_imfile_bin_snr) { + print "Rejecting exposure based on bad imfile binned S/N for $name: "; + $reject = 1; + } else { + print "Imfile binned S/N for $name meets requirements: "; + } + print "mean: $mean vs binStdev*SNlimit: " . $binStdev * $reject_imfile_bin_snr . "\n"; + } else { + print "No rejection on imfile binned S/N for $name\n"; + } +} + +# basic ensemble stats +my $mean = &value_for_flag ($cmdflags, "-bg"); +my $meanStdev = &value_for_flag ($cmdflags, "-bg_mean_stdev"); +my $stdev = &value_for_flag ($cmdflags, "-bg_stdev"); +my $binStdev = &value_for_flag ($cmdflags, "-bin_stdev"); +my $fringe_mean = &value_for_flag ($cmdflags, "-fringe_0"); +my $fringe_err = &value_for_flag ($cmdflags, "-fringe_1"); +my $fringe_mean_stdev = &value_for_flag ($cmdflags, "-fringe_2"); +my $dfringe_mean = &value_for_flag ($cmdflags, "-fringe_resid_0"); +my $dfringe_err = &value_for_flag ($cmdflags, "-fringe_resid_1"); +my $dfringe_mean_stdev = &value_for_flag ($cmdflags, "-fringe_resid_2"); + +# other stats (flux depends on bg and exp_time) +my $fluxStats = Statistics::Descriptive::Sparse->new(); # Statistics calculator for means +$fluxStats->add_data(@fluxes); +my $flux = $fluxStats->mean(); # Mean of the imfile means + +# other stats +my $exp_snr = 0.0; +if ($stdev > 0) { $exp_snr = $mean / $stdev; } + +## Reject based on the exposure ensemble stats +# reject if the exposure ensemble mean is deviant +unless ($no_op) { + print "Exposure mean $mean, stdev $stdev, mean stdev $meanStdev, exp s/n: $exp_snr\n"; + + # reject exposure if the ensemble mean residual counts deviate + # from the expected value by more than N sigma, (sigma = total + # pixel variance). this test is sensible for images which should + # have a predictable nominal residual mean count value (eg, 0.0 + # for a bias). in general, use with ADDITIVE components + if ($reject_exp_mean > 0) { + if (abs($mean) > $reject_exp_mean * $stdev) { + print "Rejecting exposure based on bad mean counts: "; + $reject = 1; + } else { + print "Exposure mean counts meets requirements: "; + } + print "mean: $mean, stdev: $stdev (limit is: " . $reject_exp_mean * $stdev . ") \n"; + } else { + print "No rejection for exp mean\n"; + } + + # reject exposure if, for any imfiles, the mean residual flux + # deviates from the expected value by more than N sigma, (sigma = + # total pixel variance). this test is sensible for images which + # should have a predictable nominal residual flux value (eg, 0.0 + # for a bias). in general, use with ADDITIVE components + if ($reject_exp_flux > 0) { + if (abs($flux) > $reject_exp_flux * $stdev) { + print "Rejecting exposure based on bad mean flux: "; + $reject = 1; + } else { + print "Exposure mean flux meets requirements: "; + } + print "flux: $flux, stdev: $stdev (limit is: " . $reject_exp_flux * $stdev . ")\n"; + } else { + print "No rejection for exp mean\n"; + } + + # reject exposure if the total pixel variance is larger than the + # limit + if ($reject_exp_stdev > 0) { + if ($stdev > $reject_exp_stdev) { + print "Rejecting exposure based on bad stdev: "; + $reject = 1; + } else { + print "Exposure stdev meets requirements: "; + } + print "$stdev vs $reject_exp_stdev\n"; + } else { + print "No rejection for exp stdev\n"; + } + + # reject exposure if the variance of the imfile means is larger + # than the limit + if ($reject_exp_meanstdev > 0) { + if ($meanStdev > $reject_exp_meanstdev) { + print "Rejecting exposure based on bad mean stdev: "; + $reject = 1; + } else { + print "Exposure mean stdev meets requirements: "; + } + print "$meanStdev vs $reject_exp_meanstdev\n"; + } else { + print "No rejection for exp mean stdev\n"; + } + + # reject if the signal-to-noise is insufficient + if ($reject_exp_snr > 0) { + if (abs($mean) < abs($stdev * $reject_exp_snr)) { + print "Rejecting exposure based on poor S/N: \n"; + $reject = 1; + } else { + print "Exposure S/N meets requirements: \n"; + } + print "signal: $mean vs noise: $stdev (s/n limit is: $reject_exp_snr)\n"; + } else { + print "No rejection for exp S/N\n"; + } + # reject if the exposure ensemble stdev is deviant + if ($reject_exp_bin_stdev > 0) { + if ($binStdev > $reject_exp_bin_stdev) { + print "Rejecting exposure based on bad binned stdev: "; + $reject = 1; + } else { + print "Exposure binned stdev meets requirements: "; + } + print "$stdev vs $reject_exp_bin_stdev\n"; + } else { + print "No rejection for exp binned stdev\n"; + } + # reject if the signal-to-noise is insufficient + if ($reject_exp_bin_snr > 0) { + if (abs($mean) < abs($binStdev * $reject_exp_bin_snr)) { + print "Rejecting exposure based on poor binned S/N: \n"; + $reject = 1; + } else { + print "Exposure binned S/N meets requirements: \n"; + } + print "signal: $mean vs noise: $binStdev (s/n limit is: $reject_exp_bin_snr)\n"; + } else { + print "No rejection for exp binned S/N\n"; + } +} + +$command = "$dettool -addresidexp -det_id $det_id -iteration $iter -exp_id $exp_id"; +$command .= " -recip $recipe -path_base $outroot "; +$command .= ' -reject' if $reject; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " $cmdflags"; + +unless ($no_update) { + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -addresidexp: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + + +sub value_for_flag +{ + my $cmdflags = shift; + my $flag = shift; + + my $value = 0.0; + if ($cmdflags =~ m|$flag|) { + ($value) = $cmdflags =~ m|$flag\s+(\S+)|; + } + $value; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + my $exp_id = shift; # Exposure tag + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $iter and defined $exp_id and not $no_update) { + my $command = "$dettool -addresidexp"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -exp_id $exp_id"; + $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Retrieve the requested rejection limit, dying if not extant +sub rejection_limit +{ + my $name = shift; # Rejection limit to + my $type = shift; # Type of exposure + my $filter = shift; # Filter + + my $value = $ipprc->rejection( $name, $det_type, $filter ); + if (not defined $value) { + $filter = "(no filter)" if not defined $filter; + die "Unable to determine $name rejection limit for $det_type with $filter.\n"; + } + + return $value; +} + +__END__ + +#### + +## this function is not well though out. it loads a collection of +## values (background mean and stdev) for a collection of imfile +## subcomponents. it then measures the mean background, the +## background stdev (rms of ensemble stdevs), and the background mean +## stdev (rms of the means). it then tries to reject based on the +## following criteria: +## (background / stdev > limit) for a single component +## ---> this will ACCEPT for a poor images (large stdev) +## (stdev > limit) +## (mean background / stdev > limit) same problem +## (mean stdev > limit) + +### I would suggest the following: +## 1) calculate the ensemble mean and stdev +## 2) for each component, is the (back - mean) / mean stdev > limit? +## (ie, is it an outlier?) +## 3) is the component stdev > limit? (absolute test) +## 4) calculate the background stdev for the ensemble (excluding rejects) +## 5) is the mean stdev > limit (poor images) +## 6) calculate the ensemble stdev (rms) of remaining (excluding rejects) +## 7) is the ensemble stdev > limit + +## for flats, the value used for stdev should be the fractional stdev +## (stdev/mean) and no rejection should be performed on the basis of +## the mean value, but could still be done on the mean stdev + +## the same logical cuts above can be applied to components in an +## imfile, imfiles in an exposure, and exposures in a stack + +### this function needs to avoid div by zero: compare Signal vs Noise*limit Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_resid_imfile.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_resid_imfile.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_resid_imfile.pl (revision 41105) @@ -0,0 +1,292 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppImage = can_run('ppImage') or (warn "Can't find ppImage" and $missing_tools = 1); +my $ppStats = can_run('ppStats') or (warn "Can't find ppStats" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $det_id, $iter, $ref_det_id, $ref_iter, $exp_id, $exp_tag, $class_id, $det_type, $detrend, $input_uri, $camera, $mode, $outroot, + $dbname, $reduction, $threads, $verbose, $no_update, $no_op, $redirect ); +GetOptions( + 'det_id|d=s' => \$det_id, + 'iteration=s' => \$iter, + 'ref_det_id=s' => \$ref_det_id, + 'ref_iter=s' => \$ref_iter, + 'exp_id|e=s' => \$exp_id, + 'exp_tag|=s' => \$exp_tag, + 'class_id|i=s' => \$class_id, + 'det_type|t=s' => \$det_type, + 'detrend=s' => \$detrend, + 'input_uri|u=s' => \$input_uri, + 'camera|c=s' => \$camera, + 'mode|m=s' => \$mode, + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'threads=s' => \$threads, # Number of threads to use for ppImage + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --iteration --ref_det_id --ref_iter --exp_id --exp_tag --class_id --det_type --camera --input_uri --mode --detrend --outroot (not for 'verify' mode)", + -exitval => 3) unless + defined $det_id and + defined $iter and + defined $ref_det_id and + defined $ref_iter and + defined $exp_id and + defined $exp_tag and + defined $class_id and + defined $det_type and + defined $input_uri and + defined $camera and + defined $mode and + defined $outroot and + defined $detrend; + +# force det_type to be upper-case in this script +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +my $logDest = $ipprc->filename("LOG.IMFILE", $outroot, $class_id) or my_die( "Unable to find LOG.IMFILE", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_CONFIG_ERROR ); +$ipprc->redirect_output($logDest) or my_die( "Unable to find LOG.IMFILE", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use as a function of detrend type and mode +# XXX probably can drop the distinct 'verify' recipes +$reduction = 'DETREND' unless defined $reduction; +my $recipe; # Name of recipe to use +if ($mode eq 'master') { + $recipe = $det_type . '_RESID'; +} elsif ($mode eq 'verify') { + $recipe = $det_type . '_VERIFY'; +} else { + &my_die("Unrecognised mode: $mode", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_PROG_ERROR); +} + +print "raw recipe: $recipe\n"; +my $ppimage_recipe = $ipprc->reduction($reduction, $recipe); +my $jpeg_recipe = $ipprc->reduction($reduction, $det_type . '_JPEG_RESID'); +print "real recipe: $recipe\n"; + +# Flags to specify the particular detrend to use +use constant DETRENDS => { + 'BIAS' => '-bias', # Specify the bias frame + 'DARK' => '-dark', # Specify the dark frame + 'DARK_PREMASK' => '-dark', # Specify the dark frame + 'DARKTEST' => '-dark', # Specify the dark frame + 'SHUTTER' => '-shutter', # Specify the shutter frame + 'FLAT_PREMASK' => '-flat', # Specify the flat frame + 'DOMEFLAT_PREMASK' => '-flat', # Specify the flat frame + 'SKYFLAT_PREMASK' => '-flat', # Specify the flat frame + 'FLAT_RAW' => '-flat', # Specify the flat frame + 'DOMEFLAT_RAW' => '-flat', # Specify the flat frame + 'SKYFLAT_RAW' => '-flat', # Specify the flat frame + 'SKYFLATTEST_RAW' => '-flat', # Specify the flat frame + 'FLAT' => '-flat', # Specify the flat frame + 'FLATTEST' => '-flat', # Specify the flat frame + 'DOMEFLAT' => '-flat', # Specify the flat frame + 'SKYFLAT' => '-flat', # Specify the flat frame + 'FRINGE' => '-fringe', # Specify the fringe frame + 'MASK' => '-mask', # Specify the mask frame + 'DARKMASK' => '-mask', # Specify the mask frame + 'FLATMASK' => '-mask', # Specify the mask frame + 'CTEMASK' => '-mask', # Specify the mask frame + 'NOISEMAP' => '-noisemap', # Specify the noisemap frame +}; + +# The output file rule name depends on the detrend type +my $FILERULES = { 'FLATMASK' => 'PPIMAGE.OUTPUT.RESID', + 'DARKMASK' => 'PPIMAGE.OUTPUT.RESID', + 'CTEMASK' => 'PPIMAGE.OUTPUT.RESID', + 'MASK' => 'PPIMAGE.OUTPUT.RESID', + 'BIAS' => 'PPIMAGE.OUTPUT.RESID', + 'DARK' => 'PPIMAGE.OUTPUT.RESID', + 'DARKTEST' => 'PPIMAGE.OUTPUT.RESID', + 'DARK_PREMASK' => 'PPIMAGE.OUTPUT.RESID', + 'SHUTTER' => 'PPIMAGE.OUTPUT.DETREND', + 'FLAT_PREMASK' => 'PPIMAGE.OUTPUT.DETREND', + 'DOMEFLAT_PREMASK' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLAT_PREMASK' => 'PPIMAGE.OUTPUT.DETREND', + 'FLAT_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'DOMEFLAT_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLAT_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLATTEST_RAW' => 'PPIMAGE.OUTPUT.DETREND', + 'FLAT' => 'PPIMAGE.OUTPUT.DETREND', + 'FLATTEST' => 'PPIMAGE.OUTPUT.DETREND', + 'DOMEFLAT' => 'PPIMAGE.OUTPUT.DETREND', + 'SKYFLAT' => 'PPIMAGE.OUTPUT.DETREND', + 'FRINGE' => 'PPIMAGE.OUTPUT.RESID', + 'NOISEMAP' => 'PPIMAGE.OUTPUT.RESID', + }; + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +# XXX use PPIMAGE.OUTPUT.RESID for output file (compressed, with pos & neg range allowed) +# my $outputName = $ipprc->filename("PPIMAGE.OUTPUT", $outroot, $class_id); + +my $filerule = $FILERULES->{$det_type}; # File rule to use + +my $outputName = $ipprc->filename($filerule, $outroot, $class_id); +my $bin1Name = $ipprc->filename("PPIMAGE.BIN1", $outroot, $class_id); +my $bin2Name = $ipprc->filename("PPIMAGE.BIN2", $outroot, $class_id); +my $outputStats = $ipprc->filename("PPIMAGE.STATS", $outroot, $class_id); +my $traceDest = $ipprc->filename("TRACE.IMFILE", $outroot, $class_id); + +my $cmdflags; + +# Run ppImage & ppStats +unless ($no_op) { + my $command = "$ppImage -file $input_uri $outroot"; + $command .= " -recipe PPIMAGE $ppimage_recipe"; + $command .= " -recipe JPEG $jpeg_recipe"; + $command .= " -recipe PPSTATS RESIDUAL"; + $command .= " -F PPIMAGE.OUTPUT $filerule"; + $command .= " -stats $outputStats"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -threads $threads" if defined $threads; + $command .= " -dbname $dbname" if defined $dbname; + + # Detrend to use in processing + my $detFlag = DETRENDS->{$det_type}; + &my_die("Unrecognised detrend type: $det_type", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_PROG_ERROR) unless defined $detFlag; + $command .= " $detFlag $detrend"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppImage: $error_code", $det_id, $iter, $exp_id, $class_id, $error_code); + } + + &my_die("Couldn't find expected output file: $outputName", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputName); + &my_die("Couldn't find expected output file: $bin1Name", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($bin1Name); + &my_die("Couldn't find expected output file: $bin2Name", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($bin2Name); + + my $outputStatsReal = $ipprc->file_resolve($outputStats); + &my_die("Couldn't find expected output file: $outputStats", $det_id, $iter, $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + # ppStatsFromMetadata $outputStats - DETREND_RESID_IMFILE + $command = "$ppStatsFromMetadata $outputStatsReal - DETREND_RESID_IMFILE"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $det_id, $iter, $exp_id, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + # run ppStats on the binned image + $command = "$ppStats -recipe PPSTATS RESIDUAL $bin2Name | $ppStatsFromMetadata - - DETREND_RESID_IMFILE_BINNED"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStats: $error_code", $det_id, $iter, $exp_id, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; +} + +# Command to update the database +my $command = "$dettool -addresidimfile"; +$command .= " -det_id $det_id"; +$command .= " -iteration $iter"; +$command .= " -ref_det_id $ref_det_id"; +$command .= " -ref_iter $ref_iter"; +$command .= " -exp_id $exp_id"; +$command .= " -class_id $class_id"; +$command .= " -recip $recipe"; +$command .= " -uri $outputName"; +$command .= " -path_base $outroot"; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " $cmdflags"; + +# Add the processed file to the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -addresidimfile: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + my $exp_id = shift; # Exposure tag + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $iter and defined $exp_id and not $no_update) { + my $command = "$dettool -addresidimfile"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -ref_det_id $ref_det_id"; + $command .= " -ref_iter $ref_iter"; + $command .= " -exp_id $exp_id"; + $command .= " -class_id $class_id"; + $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_stack.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_stack.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/detrend_stack.pl (revision 41105) @@ -0,0 +1,288 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppMerge = can_run('ppMerge') or (warn "Can't find ppMerge" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $det_id, $iter, $class_id, $det_type, $camera, $outroot, $dbname, $reduction, $threads, $verbose, $save_temps, + $no_update, $no_op, $redirect ); +GetOptions( + 'det_id|d=s' => \$det_id, + 'iteration=s' => \$iter, + 'class_id|i=s' => \$class_id, + 'det_type|t=s' => \$det_type, + 'camera|c=s' => \$camera, + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class for processing + 'threads=s' => \$threads, + 'verbose' => \$verbose, # Print to stdout + 'save-temps' => \$save_temps, # Save temporary files? + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --det_id --iteration --class_id --det_type --camera --outroot", + -exitval => 3) unless + defined $det_id and + defined $iter and + defined $class_id and + defined $det_type and + defined $camera and + defined $outroot; + +$det_type = uc($det_type); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +my $logDest = $ipprc->filename("LOG.IMFILE", $outroot, $class_id) + or &my_die("Missing entry in file rules", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); +$ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use as a function of detrend type +$reduction = "DETREND" unless defined $reduction; +my $recipe = $ipprc->reduction($reduction, $det_type . '_STACK') # Recipe name to use + or &my_die("Failed to find recipe for $det_type", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); + +# The output file rule name depends on the detrend type +my $FILERULES = { 'FLATMASK' => 'PPMERGE.OUTPUT.MASK', + 'DARKMASK' => 'PPMERGE.OUTPUT.MASK', + 'CTEMASK' => 'PPMERGE.OUTPUT.MASK', + 'MASK' => 'PPMERGE.OUTPUT.MASK', + 'BIAS' => 'PPMERGE.OUTPUT.BIAS', + 'DARK' => 'PPMERGE.OUTPUT.DARK', + 'DARK_PREMASK' => 'PPMERGE.OUTPUT.DARK', + 'DARKTEST' => 'PPMERGE.OUTPUT.DARK', + 'SHUTTER' => 'PPMERGE.OUTPUT.SHUTTER', + 'FLAT_PREMASK' => 'PPMERGE.OUTPUT.FLAT', + 'DOMEFLAT_PREMASK' => 'PPMERGE.OUTPUT.FLAT', + 'SKYFLAT_PREMASK' => 'PPMERGE.OUTPUT.FLAT', + 'FLAT_RAW' => 'PPMERGE.OUTPUT.FLAT', + 'DOMEFLAT_RAW' => 'PPMERGE.OUTPUT.FLAT', + 'SKYFLAT_RAW' => 'PPMERGE.OUTPUT.FLAT', + 'SKYFLATTEST_RAW' => 'PPMERGE.OUTPUT.FLAT', + 'FLAT' => 'PPMERGE.OUTPUT.FLAT', + 'FLATTEST' => 'PPMERGE.OUTPUT.FLAT', + 'DOMEFLAT' => 'PPMERGE.OUTPUT.FLAT', + 'SKYFLAT' => 'PPMERGE.OUTPUT.FLAT', + 'FRINGE' => 'PPMERGE.OUTPUT.FRINGE', + 'NOISEMAP' => 'PPMERGE.OUTPUT.FLAT', + }; +my $output_filerule = $FILERULES->{$det_type}; # File rule for output +&my_die("Unrecognised detrend type: $det_type", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless defined $output_filerule; + +# The stats recipe depends on the detrend type +my $STATRECIPES = {'FLATMASK' => 'DETSTATS', + 'DARKMASK' => 'DETSTATS', + 'CTEMASK' => 'DETSTATS', + 'MASK' => 'DETSTATS', + 'BIAS' => 'DETSTATS', + 'DARK' => 'DARKSTATS', + 'DARK_PREMASK' => 'DARKSTATS', + 'DARKTEST' => 'DARKSTATS', + 'SHUTTER' => 'DARKSTATS', + 'FLAT_PREMASK' => 'DETSTATS', + 'DOMEFLAT_PREMASK' => 'DETSTATS', + 'SKYFLAT_PREMASK' => 'DETSTATS', + 'FLAT_RAW' => 'DETSTATS', + 'DOMEFLAT_RAW' => 'DETSTATS', + 'SKYFLAT_RAW' => 'DETSTATS', + 'SKYFLATTEST_RAW' => 'DETSTATS', + 'FLAT' => 'DETSTATS', + 'FLATTEST' => 'DETSTATS', + 'DOMEFLAT' => 'DETSTATS', + 'SKYFLAT' => 'DETSTATS', + 'FRINGE' => 'DETSTATS', + 'NOISEMAP' => 'DETSTATS', + }; +my $statrecipe = $STATRECIPES->{$det_type}; # File rule for output + +my $cmdflags; + +# Get list of files to stack +my ($files, $command, $success, $error_code, $full_buf, $stdout_buf, $stderr_buf); +{ + $command = "$dettool -processedimfile -included"; + $command .= " -det_id $det_id"; + $command .= " -class_id $class_id"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool -processedimfile: $error_code", $det_id, $iter, $class_id, $error_code); + } + + my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $det_id, $iter, $class_id, $PS_EXIT_PROG_ERROR); + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $det_id, $iter, $class_id, $PS_EXIT_PROG_ERROR); +} + +# Generate MDC file with the inputs +my ($listFile, $listName) = $ipprc->create_temp_file("$outroot.$class_id.list", $save_temps); + +my $num = 0; +foreach my $file (@$files) { + if ($file->{ignored}) { next; } + + print $listFile "INPUT$num\tMETADATA\n"; + $num++; + + my $image = $file->{uri}; # Image name + my $mask = $ipprc->filename( "PPIMAGE.OUTPUT.MASK", $file->{path_base}, $class_id ); # Mask name + my $weight = $ipprc->filename( "PPIMAGE.OUTPUT.VARIANCE", $file->{path_base}, $class_id ); # Weight name + + &my_die("Image $image does not exist", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists( $image ); + print $listFile "\tIMAGE\tSTR\t" . $image . "\n"; + + if ($ipprc->file_exists( $mask )) { + print $listFile "\tMASK\tSTR\t" . $mask . "\n"; + } + if ($ipprc->file_exists( $weight )) { + print $listFile "\tVARIANCE\tSTR\t" . $weight . "\n"; + } + + print $listFile "END\n\n"; +} +close $listFile; + + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +my $outputStack = $ipprc->filename($output_filerule, $outroot, $class_id) or &my_die("Missing entry in file rules", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); # Output name +my $outputCount = $ipprc->filename("PPMERGE.OUTPUT.COUNT", $outroot, $class_id) or &my_die("Missing entry in file rules", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); # Count image +my $outputSigma = $ipprc->filename("PPMERGE.OUTPUT.SIGMA", $outroot, $class_id) or &my_die("Missing entry in file rules", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); # Stdev image +my $outputStats = $ipprc->filename("PPIMAGE.STATS", $outroot, $class_id) or &my_die("Missing entry in file rules", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); # Statistics name +my $traceDest = $ipprc->filename("TRACE.IMFILE", $outroot, $class_id) or &my_die("Missing entry in file rules", $det_id, $iter, $class_id, $PS_EXIT_CONFIG_ERROR); # Trace messages + +$command = "$ppMerge $listName $outroot"; # Command to run +$command .= " -recipe PPMERGE $recipe"; +$command .= " -type $det_type"; # Type of stacking to perform +$command .= " -stats $outputStats"; # Statistics output filename +$command .= " -recipe PPSTATS $statrecipe"; +$command .= " -tracedest $traceDest -log $logDest"; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " -threads $threads" if defined $threads; + +# Stack the files +unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppMerge: $error_code", $det_id, $iter, $class_id, $error_code); + } + &my_die("Unable to find expected output file: $outputStack\n", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStack); + &my_die("Unable to find expected output file: $outputCount\n", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputCount); + &my_die("Unable to find expected output file: $outputSigma\n", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputSigma); + + my $outputStatsReal = $ipprc->file_resolve($outputStats); + &my_die("Couldn't find expected output file: $outputStats", $det_id, $iter, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + # parse stats from metadata + $command = "$ppStatsFromMetadata $outputStatsReal - DETREND_STACK"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $det_id, $iter, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; +} + +# Command to update the database +$command = "$dettool -addstacked"; +$command .= " -det_id $det_id"; +$command .= " -iteration $iter"; +$command .= " -class_id $class_id"; +$command .= " -uri $outputStack"; +$command .= " -recip $recipe"; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " $cmdflags"; + +# Add the resultant into the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform dettool -addstacked: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $det_id and defined $iter and defined $class_id and not $no_update) { + my $command = "$dettool -addstacked"; + $command .= " -det_id $det_id"; + $command .= " -iteration $iter"; + $command .= " -class_id $class_id"; + # XXX EAM : we should add this to the db : $command .= " -path_base $outroot"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/diff_skycell.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/diff_skycell.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/diff_skycell.pl (revision 41105) @@ -0,0 +1,574 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $ppSub = can_run('ppSub') or (warn "Can't find ppSub" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $nebInsert = can_run('neb-insert') or (warn "Can't find neb-insert" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($diff_id, $dbname, $threads, $outroot, $reduction, $inverse, $run_state, $verbose, $no_update, $no_op, $redirect); +my ($skycell_id, $diff_skyfile_id); +my ($use_convolved); + +GetOptions( + 'diff_id=s' => \$diff_id, # Diff identifier + 'skycell_id=s' => \$skycell_id, # Skycell identifier + 'diff_skyfile_id=s' => \$diff_skyfile_id, # Diff identifier + 'dbname|d=s' => \$dbname, # Database name + 'threads=s' => \$threads, # Number of threads to use + 'run-state=s' => \$run_state, # state for run: 'new' or 'update' + 'outroot=s' => \$outroot, # Output root name + 'inverse' => \$inverse, # Make inverse subtraction? + 'reduction=s' => \$reduction, # Reduction class + 'use_convolved' => \$use_convolved, # Use convolved stacks instead of unconvolved. + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --diff_id --skycell_id --outroot --run-state --diff_skyfile_id", + -exitval => 3, + ) unless defined $diff_id + and defined $skycell_id + and defined $diff_skyfile_id + and defined $run_state + and defined $outroot; + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $diff_id, $skycell_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $neb; +my $scheme = file_scheme($outroot); +if ($scheme and $scheme eq 'neb') { + $neb = $ipprc->nebulous(); +} + +# XXX camera is not known here; cannot use filerules... +my $logDest = "$outroot.log"; +my $updateMode = 0; +if ($run_state eq 'update') { + $logDest .= '.update'; + $updateMode = 1; +} +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +my $source_id = $ipprc->source_id($dbname, $PS_TABLE_ID_DIFF); + +# Get list of components for subtraction +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $files; +{ + my $command = "$difftool -inputskyfile -diff_id $diff_id -skycell_id $skycell_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool -inputskyfile: $error_code", $diff_id, $skycell_id, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $diff_id, $skycell_id, $PS_EXIT_PROG_ERROR); + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $diff_id, $skycell_id, $PS_EXIT_PROG_ERROR); +} + +&my_die("Subtraction list does not contain exactly two elements", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless scalar @$files == 2; + +# Identify the input and the template +my ($input, $inputMask, $inputVariance, $inputPath, $inputSources); # Input files and path +my ($template, $templateMask, $templateVariance, $templatePath, $templateSources); # Template files and path +my $tess_id; # Tesselation identifier +my $camera; # Camera +my ($inputMagic, $templateMagic); # Are the inputs been magicked? +my ($saveInConv, $saveRefConv); # Save the input or reference convolved images? +# CZW 2013-03-21: We only want to use unconvolved inputs. Ever, if I understand correctly. +unless ($use_convolved) { + $use_convolved = 0; +} + +# # Prescan to decide if this is or is not a stack stack diff. The check above confirms we only have two entries. +# if ((${ $files }[0]->{warp_id} != 0)&& +# (${ $files }[1]->{warp_id} != 0)) { +# # Both are zero, so stack stack diff; +# } +# else { + +# # We're in some sort of warp stack or warp warp (don't care about the last one.) +# $use_convolved = 1; ## This is a hack to do a test for mops, and should not be committed. +# } + +# Re-implement prescan to decide if this is a warp-stack or warp-warp. Or stack-stack, but that's what we don't care about now. +my $diff_type = ''; + +if ((${ $files }[0]->{warp_id} != 0)&&(${ $files }[1]->{warp_id} != 0)) { + $diff_type = "WW"; +} +elsif ((${ $files }[0]->{stack_id} != 0)&&(${ $files }[1]->{stack_id} != 0)) { + $diff_type = "SS"; +} +elsif (((${ $files }[0]->{warp_id} != 0)&&(${ $files }[1]->{stack_id} != 0))) { + $diff_type = "WS"; +} +else { # Something has gone horribly wrong. + $diff_type = "WW"; # just pretend it never happened, and let it fail elsewhere. +} + +# ppSub does (input) - (template) after PSF-match convolution. +# one of the files needs to be assigned to 'input' and the other to 'template'. +# if either of these is a WARP, then we can perform magic on it. If we are going to +# run magic, then we need to save the convolved version of the OTHER image +# (see magic_process.pl:155) + +foreach my $file (@$files) { + if (defined $file->{template} and $file->{template}) { + $templatePath = $file->{path_base}; + if ($file->{warp_id} == 0) { + if ($use_convolved) { + $template = "PPSTACK.OUTPUT"; + $templateMask = "PPSTACK.OUTPUT.MASK"; + $templateVariance = "PPSTACK.OUTPUT.VARIANCE"; + } + else { + $template = "PPSTACK.UNCONV"; + $templateMask = "PPSTACK.UNCONV.MASK"; + $templateVariance = "PPSTACK.UNCONV.VARIANCE"; + } + $templateSources = "PSPHOT.OUT.CMF.MEF"; ## this must be consistent with the value in stack_skycell.pl + # template is a stack so it doesn't need to be magicked + $templateMagic = 1; + ## use an explicit stack name for psphot output objects + } else { + $template = "PSWARP.OUTPUT"; + $templateMask = "PSWARP.OUTPUT.MASK"; + $templateVariance = "PSWARP.OUTPUT.VARIANCE"; + $templateSources = "PSWARP.OUTPUT.SOURCES"; + $templateMagic = $file->{magicked}; + $saveInConv = 1; + } + } else { + $inputPath = $file->{path_base}; + $inputMagic = $file->{magicked}; # if input is a stack the output can't be "magicked" + if ($file->{warp_id} == 0) { + if ($use_convolved) { + $input = "PPSTACK.OUTPUT"; + $inputMask = "PPSTACK.OUTPUT.MASK"; + $inputVariance = "PPSTACK.OUTPUT.VARIANCE"; + } + else { + $input = "PPSTACK.UNCONV"; + $inputMask = "PPSTACK.UNCONV.MASK"; + $inputVariance = "PPSTACK.UNCONV.VARIANCE"; + } + $inputSources = "PSPHOT.OUT.CMF.MEF"; ## this must be consistent with the value in stack_skycell.pl + } else { + $input = "PSWARP.OUTPUT"; + $inputMask = "PSWARP.OUTPUT.MASK"; + $inputVariance = "PSWARP.OUTPUT.VARIANCE"; + $inputSources = "PSWARP.OUTPUT.SOURCES"; + $saveRefConv = 1; + } + } + if (defined $tess_id) { + &my_die("Tesselation identifiers don't match", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless + $file->{tess_id} eq $tess_id; + } else { + $tess_id = $file->{tess_id}; + } + &my_die("Skycell identifiers don't match", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless + $file->{skycell_id} eq $skycell_id; + if (defined $camera) { + &my_die("Cameras don't match", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $file->{camera} eq $camera; + } else { + $camera = $file->{camera}; + } +} + +## EAM 2015.03.12 : for the PV3 3pi diffs, we do NOT want to save these images. here i am hacking this value to 0, but it should depend on the +## values in filerules or recipe... +$saveInConv = 0; +$saveRefConv = 0; +## MEH adding above from ipptest:ipp-20150312 hack.. +## -- of course this wont work because of the poor code doing a defined check rather than value check.. so fix... +undef $saveInConv; +undef $saveRefConv; + +&my_die("Unable to identify template", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless defined $template; +&my_die("Unable to identify input", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless defined $input; +&my_die("Unable to identify camera", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless defined $camera; +$ipprc->define_camera($camera); + +# Compute the magicked status of the output. +# The output file will be considered magicked if the input has been magicked and the +# template is either a stack or a warp that has been magicked. +my $magicked = $inputMagic && $templateMagic ? $inputMagic : 0; + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_ppSub = $ipprc->reduction($reduction, 'DIFF_PPSUB'); # Recipe to use for ppSub +my $recipe_psphot = $ipprc->reduction($reduction, 'DIFF_PSPHOT'); # Recipe to use for psphot +my $recipe_ppstats = 'DIFFSTATS'; +unless ($recipe_ppSub and $recipe_psphot) { + &my_die("Couldn't find selected reduction for DIFF_PPSUB and DIFF_PSPHOT: $reduction\n", $diff_id, $skycell_id, $PS_EXIT_CONFIG_ERROR); +} + +print "reduction: $reduction\n"; +print "recipe_ppSub: $recipe_ppSub\n"; + +# print "templateMask: $templateMask\n"; +# print "templatePath: $templatePath\n"; +# print "inputMask: $inputMask\n"; +# print "inputPath: $inputPath\n"; +# print "templateVariance: $templateVariance\n"; +# print "inputVariance: $inputVariance\n"; +# print "templateSources: $templateSources\n"; +# print "inputSources: $inputSources\n"; + +$input = $ipprc->filename($input, $inputPath); +$inputMask = $ipprc->filename($inputMask, $inputPath); +$inputVariance = $ipprc->filename($inputVariance, $inputPath); +$inputSources = $ipprc->filename($inputSources, $inputPath); + +$template = $ipprc->filename($template, $templatePath); +$templateMask = $ipprc->filename($templateMask, $templatePath); +$templateVariance = $ipprc->filename($templateVariance, $templatePath); +$templateSources = $ipprc->filename($templateSources, $templatePath); + +print "template: $template\n"; +print "templateMask: $templateMask\n"; +print "templatePath: $templatePath\n"; +print "input: $input\n"; +print "inputMask: $inputMask\n"; +print "inputPath: $inputPath\n"; +print "templateVariance: $templateVariance\n"; +print "inputVariance: $inputVariance\n"; +print "templateSources: $templateSources\n"; +print "inputSources: $inputSources\n"; + +&my_die("Couldn't find input: $template", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($template); +&my_die("Couldn't find input: $templateMask", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($templateMask); +&my_die("Couldn't find input: $templateVariance", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($templateVariance); +#&my_die("Couldn't find input: $templateSources", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($templateSources); + +## MEH -- needs to be for both kinds of diffs using stacks... +if ($diff_type eq 'WS' || $diff_type eq 'SS') { + # LANL processed stack images do not have a set of sources transferred back, so we need to choose a different source list. + unless($ipprc->file_exists($templateSources)) { + if ($ipprc->file_exists($inputSources)) { + $templateSources = $inputSources; + print "CHANGED:templateSources: $templateSources\n"; + } + } + &my_die("Couldn't find input: $templateSources", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($templateSources); +} +else { + &my_die("Couldn't find input: $templateSources", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($templateSources); +} +&my_die("Couldn't find input: $input", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($input); +&my_die("Couldn't find input: $inputMask", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputMask); +&my_die("Couldn't find input: $inputVariance", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputVariance); +&my_die("Couldn't find input: $inputSources", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputSources); + +# Get the output filenames +my $configuration; +my $outputStats; +my $traceDest; +my $do_photom = 1; +my $dump_config = 1; +if ($reduction eq 'NOCONVDIFF') { + $do_photom = 0; +} +if ($run_state eq 'new') { + $configuration = prepare_output("PPSUB.CONFIG", $outroot, 1); + $traceDest = prepare_output("TRACE.EXP", $outroot, 1); + $outputStats = prepare_output("SKYCELL.STATS", $outroot, 1); +} else { + $do_photom = 0; + $dump_config = 0; + $traceDest = prepare_output("TRACE.EXP.UPDATE", $outroot, 1); + # we rerun stats because we need the quality value + $outputStats = prepare_output("SKYCELL.STATS.UPDATE", $outroot, 1); + $configuration = $ipprc->filename("PPSUB.CONFIG", $outroot); + # XXX: Work around problem with updating old diff runs. Their config files are incompatible + # with the current code. + if ($camera ne 'GPC1' or $diff_id >= 88268) { + if (!$ipprc->file_exists($configuration)) { + print STDERR "WARNING: Config dump file $configuration is missing. Using current recipes and file rules.\n"; + $configuration = undef; + } + } else { + print STDERR "WARNING: Using new recipes because config dump file is too old\n"; + $configuration = undef; + } + + # use WARPSTATS if we're updating, as we don't care about the new stuff from the STACK and DIFF STATS recipes. + # The only value that we use is -quality + $recipe_ppstats = 'WARPSTATS'; +} + +my $outputName = prepare_output("PPSUB.OUTPUT", $outroot, 1); +my $outputMask = prepare_output("PPSUB.OUTPUT.MASK", $outroot, 1); +my $outputVariance = prepare_output("PPSUB.OUTPUT.VARIANCE", $outroot, 1); +my $outputSources = prepare_output("PPSUB.OUTPUT.SOURCES", $outroot, 1) if $do_photom; +my $jpeg1Name = prepare_output("PPSUB.OUTPUT.JPEG1", $outroot, 1); +my $jpeg2Name = prepare_output("PPSUB.OUTPUT.JPEG2", $outroot, 1); + +# do we always need to prepare this file? +if ($reduction ne 'NOCONVDIFF') { + my $refConv = prepare_output("PPSUB.REF.CONV", $outroot, 1); +} + +my ($inverseName, $inverseMask, $inverseVariance, $inverseSources); +if ($inverse) { + $inverseName = prepare_output("PPSUB.INVERSE", $outroot, 1); + $inverseMask = prepare_output("PPSUB.INVERSE.MASK", $outroot, 1); + $inverseVariance = prepare_output("PPSUB.INVERSE.VARIANCE", $outroot, 1); + $inverseSources = prepare_output("PPSUB.INVERSE.SOURCES", $outroot, 1) if $do_photom; +} + +my $cmdflags; + +# Perform subtraction +{ + my $command = "$ppSub $outroot"; + $command .= " -updatemode" if $updateMode; + $command .= " -inimage $input"; + $command .= " -refimage $template"; + $command .= " -inmask $inputMask"; + $command .= " -refmask $templateMask"; + $command .= " -invariance $inputVariance"; + $command .= " -refvariance $templateVariance"; + $command .= " -insources $inputSources"; + $command .= " -refsources $templateSources"; + $command .= " -stats $outputStats"; + $command .= " -threads $threads" if defined $threads; + if ($dump_config) { + $command .= " -dumpconfig $configuration"; + } elsif ($configuration) { + $command .= " -ipprc $configuration"; + } + $command .= " -save-inconv" if defined $saveInConv and $run_state eq "new"; + $command .= " -save-refconv" if defined $saveRefConv and $run_state eq "new"; + $command .= " -recipe PPSUB $recipe_ppSub"; + $command .= " -recipe PSPHOT $recipe_psphot"; + $command .= " -recipe PPSTATS $recipe_ppstats"; + $command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE"; + $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + $command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF"; + if ($do_photom) { + $command .= " -photometry"; + } else { + $command .= " -Db PHOTOMETRY FALSE"; + } + $command .= " -inverse" if $inverse; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " -image_id $diff_skyfile_id" if defined $diff_skyfile_id; + $command .= " -source_id $source_id" if defined $source_id; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppSub: $error_code", $diff_id, $skycell_id, $error_code); + } + + check_output($outputStats, 1); + my $outputStatsReal = $ipprc->file_resolve($outputStats); + + # measure chip stats + $command = "$ppStatsFromMetadata $outputStatsReal - DIFF_SKYCELL"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $diff_id, $skycell_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + my ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + + if (!$quality) { + check_output($outputName, 0); + check_output($outputMask, 0); + check_output($outputVariance, 0); + check_output($outputSources, 1) if $do_photom; + check_output($jpeg1Name, 1); + check_output($jpeg2Name, 1); + if ($inverse) { + check_output($inverseName, 0); + check_output($inverseMask, 0); + check_output($inverseVariance, 0); + check_output($inverseSources, 1) if $do_photom; + if ($run_state eq 'new') { + check_output($configuration, 1); + } + } + if ($reduction eq 'NOCONVDIFF') { + my $refConv = prepare_output("PPSUB.REF.CONV", $outroot, 0); + my $templateFile = $ipprc->file_resolve($template,0); + $command = "$nebInsert $refConv $templateFile"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform neb-insert: $error_code", $diff_id, $skycell_id, $error_code); + } + } + + + } elsif ($run_state eq 'update') { + &my_die("Update resulted in poor quality image: $quality", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR); + } + } else { + print "Not executing: $command\n"; + } +} + +unless ($no_update) { + + # Add the subtraction result + { + my $command = "$difftool -diff_id $diff_id -skycell_id $skycell_id"; + $command .= " -magicked $magicked" if $magicked; + if ($run_state eq 'new') { + $command .= " -adddiffskyfile -path_base $outroot"; + $command .= " $cmdflags"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + } else { + $command .= " -tofullskyfile"; + } + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = $run_state eq "update" ? + "Unable to perform difftool -adddiffskyfile" : + "Unable to perform difftool -tofullskyfile"; + &my_die("$err_message: $error_code", $diff_id, $skycell_id, $error_code); + } + } +} +exit 0; + + +# Prepare to write to an output file +# Lookup the filename in the rules. +# Make sure that if file exists and is a nebulous file that there is only one instance +# Deal with files that have been lost. +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, undef, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $diff_id, $skycell_id, $error); + return $output; +} + +sub check_output +{ + my $file = shift; + my $replicate = shift; + + if (!defined $file) { + return; + } + + &my_die("Couldn't find expected output file: $file", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($file); + + # Funpack to confirm we've really made things correctly + my $diskfile = $ipprc->file_resolve($file); + if ($diskfile =~ /fits/) { + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR); + my $check_command = "$funpack -S $diskfile > /dev/null"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $check_command, verbose => $verbose); + if (!$success) { + &my_die("Output file not a valid fits file: $file", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR); + } + } + ##### + + + if ($replicate and $neb) { + $ipprc->replicate_file($file) or &my_die("failed to replicate: $file\n", $diff_id, $skycell_id, $PS_EXIT_SYS_ERROR); + } +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $diff_id = shift; # Diff identifier + my $skycell_id = shift; # Skycell identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $diff_id and defined $skycell_id and not $no_update) { + my $command = "$difftool -diff_id $diff_id -skycell_id $skycell_id -fault $exit_code"; + if ($run_state eq 'new') { + $command .= " -adddiffskyfile"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -path_base $outroot" if defined $outroot; + } else { + $command .= " -updatediffskyfile"; + } + $command .= " -dbname $dbname" if defined $dbname; + run(command => $command, verbose => $verbose); + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/diffphot.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/diffphot.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/diffphot.pl (revision 41105) @@ -0,0 +1,292 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $diffphottool = can_run('diffphottool') or (warn "Can't find diffphottool" and $missing_tools = 1); +my $psphot = can_run('psphot') or (warn "Can't find psphot" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($diff_phot_id, $skycell_id, $dbname, $threads, $outroot, $reduction, $verbose, $no_update, $no_op, $redirect, $save_temps); +GetOptions( + 'diff_phot_id=s' => \$diff_phot_id, # Diffphot identifier + 'skycell_id=s' => \$skycell_id, # Skycell identifier + 'dbname|d=s' => \$dbname, # Database name + 'threads=s' => \$threads, # Number of threads to use + 'outroot=s' => \$outroot, # Output root name + 'reduction=s' => \$reduction, # Reduction class + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --diff_phot_id --skycell_id --outroot", + -exitval => 3, + ) unless defined $diff_phot_id + and defined $skycell_id + and defined $outroot; + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $diff_phot_id, $skycell_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +# XXX camera is not known here; cannot use filerules... +# my $logDest = $ipprc->filename("LOG.EXP", $outroot); +my $logDest = "$outroot.log"; +$ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Get input components +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $inputPath; # Input path +my $camera; # Camera name +my $bothways; # Diff was done both ways? +my $magicked; # Magic status +{ + my $command = "$diffphottool -input -diff_phot_id $diff_phot_id -skycell_id $skycell_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool -inputskyfile: $error_code", $diff_phot_id, $skycell_id, $error_code); + } + + my $files = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $diff_phot_id, $skycell_id, $PS_EXIT_PROG_ERROR); + &my_die("File list does not contain exactly one entry", $diff_phot_id, $skycell_id, $PS_EXIT_PROG_ERROR) unless scalar @$files == 1; + my $file = $$files[0]; # File of interest + $inputPath = $file->{path_base}; + $camera = $file->{camera}; + $bothways = $file->{bothways}; + $magicked = $file->{magicked}; +} + +&my_die("Unable to identify input", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless defined $inputPath; +&my_die("Unable to identify camera", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless defined $camera; +$ipprc->define_camera($camera); + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_psphot = $ipprc->reduction($reduction, 'DIFF_PSPHOT'); # Recipe to use for psphot +my $recipe_ppstats = 'DIFFSTATS'; +&my_die("Couldn't find selected reduction for DIFF_PSPHOT: $reduction\n", $diff_phot_id, $skycell_id, $PS_EXIT_CONFIG_ERROR) unless ($recipe_psphot); + +# Input filenames +my $inputImage = $ipprc->filename("PPSUB.OUTPUT", $inputPath); +my $inputMask = $ipprc->filename("PPSUB.OUTPUT.MASK", $inputPath); +my $inputVariance = $ipprc->filename("PPSUB.OUTPUT.VARIANCE", $inputPath); +my $inputPSF = $ipprc->filename("PSPHOT.PSF.SKY.SAVE", $inputPath); +&my_die("Couldn't find input: $inputImage", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputImage); +&my_die("Couldn't find input: $inputMask", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputMask); +&my_die("Couldn't find input: $inputVariance", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputVariance); +&my_die("Couldn't find input: $inputPSF", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputPSF); + +my $quality; # Quality flag + +# Do forward photometry +{ + # Get the output filenames + my $outputName = $ipprc->filename("PSPHOT.OUT.CMF.MEF", "$outroot.pos"); + my $outputStats = $ipprc->filename("SKYCELL.STATS", "$outroot.pos"); + my $traceDest = $ipprc->filename("TRACE.EXP", "$outroot.pos"); + + my $command = "$psphot $outroot.pos"; + $command .= " -file $inputImage"; + $command .= " -mask $inputMask"; + $command .= " -variance $inputVariance"; + $command .= " -psf $inputPSF"; +# $command .= " -stats $outputStats"; + $command .= " -threads $threads" if defined $threads; + $command .= " -recipe PSPHOT $recipe_psphot"; + $command .= " -recipe PPSTATS $recipe_ppstats"; + $command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE"; + $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + $command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psphot: $error_code", $diff_phot_id, $skycell_id, $error_code); + } + + if (0) { # psphot doesn't produce a stats file + my $outputStatsReal = $ipprc->file_resolve($outputStats); + &my_die("Couldn't find expected output file: $outputStats", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + $command = "$ppStatsFromMetadata $outputStatsReal - DIFF_SKYCELL"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $diff_phot_id, $skycell_id, $error_code); + } + my $cmdflags = ""; + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + if ($cmdflags =~ /-quality (\d+)/) { + $quality = $1; + } + } + + if (!$quality) { + &my_die("Couldn't find expected output file: $outputName", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputName); + } + } else { + print "Not executing: $command\n"; + } +} + +# Do reverse photometry +if ($bothways) { + my $inputImage = $ipprc->filename("PPSUB.INVERSE", $inputPath); + my $inputMask = $ipprc->filename("PPSUB.INVERSE.MASK", $inputPath); + my $inputVariance = $ipprc->filename("PPSUB.INVERSE.VARIANCE", $inputPath); + &my_die("Couldn't find input: $inputImage", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputImage); + &my_die("Couldn't find input: $inputMask", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputMask); + &my_die("Couldn't find input: $inputVariance", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputVariance); + + # Get the output filenames + my $outputName = $ipprc->filename("PSPHOT.OUT.CMF.MEF", "$outroot.neg"); + my $outputStats = $ipprc->filename("SKYCELL.STATS", "$outroot.neg"); + my $traceDest = $ipprc->filename("TRACE.EXP", "$outroot.neg"); + + my $command = "$psphot $outroot.neg"; + $command .= " -file $inputImage"; + $command .= " -mask $inputMask"; + $command .= " -variance $inputVariance"; + $command .= " -psf $inputPSF"; +# $command .= " -stats $outputStats"; + $command .= " -threads $threads" if defined $threads; + $command .= " -recipe PSPHOT $recipe_psphot"; + $command .= " -recipe PPSTATS $recipe_ppstats"; + $command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE"; + $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + $command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psphot: $error_code", $diff_phot_id, $skycell_id, $error_code); + } + + if (0) { # psphot doesn't produce a stats file + my $outputStatsReal = $ipprc->file_resolve($outputStats); + &my_die("Couldn't find expected output file: $outputStats", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + $command = "$ppStatsFromMetadata $outputStatsReal - DIFF_SKYCELL"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $diff_phot_id, $skycell_id, $error_code); + } + my $cmdflags = ""; + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + if ($cmdflags =~ /-quality (\d+)/) { + $quality = $1; + } + } + + if (!$quality) { + &my_die("Couldn't find expected output file: $outputName", $diff_phot_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputName); + } + } else { + print "Not executing: $command\n"; + } +} + +{ + my $command = "$diffphottool -diff_phot_id $diff_phot_id -skycell_id $skycell_id"; + $command .= " -done -path_base $outroot"; + $command .= " -magicked $magicked" if defined $magicked; + $command .= " -quality $quality" if defined $quality; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Command failed: $error_code", $diff_phot_id, $skycell_id, $error_code); + } + } else { + print "Skipping update: $command\n"; + } +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $diff_phot_id = shift; # Diff identifier + my $skycell_id = shift; # Skycell identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $diff_phot_id and defined $skycell_id and not $no_update) { + my $command = "$diffphottool -done"; + $command .= " -diff_phot_id $diff_phot_id -skycell_id $skycell_id -fault $exit_code"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -path_base $outroot" if defined $outroot; + $command .= " -dbname $dbname" if defined $dbname; + run(command => $command, verbose => $verbose); + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_advancerun.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_advancerun.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_advancerun.pl (revision 41105) @@ -0,0 +1,392 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( dirname); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($dist_id, $stage, $stage_id, $outdir, $clean, $camera); +my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile); + +GetOptions( + 'dist_id=s' => \$dist_id,# Magic destreak run identifier + 'camera=s' => \$camera, + 'stage=s' => \$stage, # raw, chip, warp, or diff + 'stage_id=s' => \$stage_id, # exp_id, chip_id, warp_id, or diff_id + 'clean' => \$clean, # exporting a clean run + 'outdir=s' => \$outdir, # "directory" for outputs + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dist_id --stage --stage_id --outdir", + -exitval => 3) unless + defined $dist_id and + defined $stage and + defined $stage_id and + defined $outdir; + +my $ipprc = PS::IPP::Config->new($camera); # IPP configuration + +$ipprc->redirect_output($logfile) if $logfile; + +# Look for programs we need +my $missing_tools; +my $disttool = can_run('disttool') or (warn "Can't find disttool" and $missing_tools = 1); +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $faketool = can_run('faketool') or (warn "Can't find faketool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $bgtool = can_run('bgtool') or (warn "Can't find bgtool" and $missing_tools = 1); +my $fftool = can_run('fftool') or (warn "Can't find fftool" and $missing_tools = 1); +my $staticskytool = can_run('staticskytool') or (warn "Can't find staticskytool" and $missing_tools = 1); +if ($missing_tools) { + &my_die("Can't find required tools.", $dist_id, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; + +my $tool_cmd; +my $tool_cmd2; +my $list_mode; +my $component_key; +if ($stage eq "raw") { + $tool_cmd = "$regtool -exp_id"; + $list_mode = "-processedimfile"; + $component_key = "class_id"; +} elsif ($stage eq "chip") { + $tool_cmd = "$chiptool -chip_id"; + $list_mode = "-processedimfile"; + $component_key = "class_id"; +} elsif ($stage eq "chip_bg") { + $tool_cmd = "$bgtool -chip_bg_id"; + $list_mode = "-chip"; + $component_key = "class_id"; +} elsif ($stage eq "camera") { + $tool_cmd = "$camtool -cam_id"; + $list_mode = "-processedexp"; + $component_key = ""; +} elsif ($stage eq "fake") { + $tool_cmd = "$faketool -fake_id"; + $list_mode = "-processedimfile"; + $component_key = "class_id"; +} elsif ($stage eq "warp") { + $tool_cmd = "$warptool -warp_id"; + $list_mode = "-warped"; + $component_key = "skycell_id"; +} elsif ($stage eq "warp_bg") { + $tool_cmd = "$bgtool -warp_bg_id"; + $list_mode = "-warp"; + $component_key = "skycell_id"; +} elsif ($stage eq "stack") { + $tool_cmd = "$stacktool -stack_id"; + $list_mode = "-sumskyfile"; + $component_key = "skycell_id"; +} elsif ($stage eq "sky") { + $tool_cmd = "$staticskytool -sky_id"; + $list_mode = "-result"; + $component_key = "skycell_id"; +} elsif ($stage eq "skycal") { + $tool_cmd = "$staticskytool -skycal_id"; + $list_mode = "-skycalresult"; + $component_key = "skycell_id"; +} elsif ($stage eq "diff") { + $tool_cmd = "$difftool -diff_id"; + $list_mode = "-diffskyfile"; + $component_key = "skycell_id"; +} elsif ($stage eq "SSdiff") { + $tool_cmd = "$difftool -diff_id"; + $list_mode = "-diffskyfile"; + $component_key = "skycell_id"; +} elsif ($stage eq "ff") { + $tool_cmd = "$fftool -ff_id"; + $list_mode = "-result"; + $component_key = "dist_component"; + $tool_cmd2 = "$fftool -summary -ff_id" +} else { + &my_die("Unexpected stage: $stage", $dist_id, $PS_EXIT_CONFIG_ERROR); +} + +$tool_cmd .= " $stage_id"; +$tool_cmd2 .= " $stage_id" if $tool_cmd2; + +my $exportarg = '-exportrun'; +if ($stage eq 'chip_bg') { + $exportarg = '-exportchip'; +} elsif ($stage eq 'warp_bg') { + $exportarg = '-exportwarp'; +} elsif ($stage eq 'skycal') { + $exportarg = '-exportskycalrun'; +} + + +# work around the fact that $ipprc->file_create does not actually create a file on disk +# unless the scheme is nebulous +sub create_file { + my $rule = shift; + my $path_base = shift; + my $ref = shift; + + my $file; + + my $error; + $file = $ipprc->prepare_output($rule, $path_base, undef, 1, \$error) + or &my_die("Unable to prepare outut for $rule", $dist_id, $PS_EXIT_SYS_ERROR); + + my $scheme = file_scheme($file); + $scheme = "" if !$scheme; + + my $resolved; + if ($scheme) { + $ipprc->file_create($file) + or &my_die("Unable to create $file", $dist_id, $PS_EXIT_SYS_ERROR); + + $resolved = $ipprc->file_resolve($file) + or &my_die("Unable to resolve $file", $dist_id, $PS_EXIT_SYS_ERROR); + + if ($scheme eq 'neb') { + &my_die("$resolved not found", $dist_id, $PS_EXIT_SYS_ERROR) unless ($resolved and -e $resolved); + } + } else { + $resolved = $file; + } + $$ref = $resolved; + + return $file +} + +my $dbinfo_root = "$outdir/dbinfo.$stage.$stage_id"; +my $resolved; +my $dbinfo_file = create_file("DIST.OUTPUT.DBINFO", $dbinfo_root, \$resolved); + +{ + my $command = "$tool_cmd $exportarg -outfile $resolved"; + $command .= " -clean" if ((defined $clean) and ($stage ne "raw")); + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } +} + +my $dirinfo_root = "$outdir/dirinfo.$stage.$stage_id"; +my $dirinfo = create_file("DIST.OUTPUT.DIRINFO", $dirinfo_root, \$resolved); + +{ + my $command = "$tool_cmd $list_mode"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } + if (@$stdout_buf == 0) { + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + + if ($tool_cmd2) { + my $command = "$tool_cmd2"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } + if (@$stdout_buf == 0) { + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + my $more_components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + if (scalar @$more_components) { + push @$components, @$more_components; + } + } + + open MANIFEST, ">$resolved" or + &my_die("Unable to open dirinfo file $resolved", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + + my $destdir; + foreach my $c (@$components) { + # take the workdir from the first component + if (!$destdir) { + my $workdir = $c->{workdir}; + if ($workdir) { + $destdir = stripvolume($workdir, $stage); + } elsif ($stage eq 'raw') { + $destdir = 'none'; + } else { + &my_die("workdir not found for open dirinfo file $dirinfo", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + } + print MANIFEST "destdir METADATA\n"; + print MANIFEST "\t" , "destdir", "\tSTR\t", $destdir, "\n"; + print MANIFEST "END\n\n"; + print MANIFEST "components METADATA\n"; + } + my $component = $c->{$component_key} ? $c->{$component_key} : "exposure"; + my $path; + if ($stage eq 'raw') { + $path = $c->{uri}; + } else { + $path = $c->{path_base}; + } + &my_die("unable to find path", $dist_id, $PS_EXIT_UNKNOWN_ERROR) if !$path; + my $component_dir = find_componentdir($destdir, $path); + print MANIFEST "\t" , "$component", "\tSTR\t", $component_dir, "\n"; + } + print MANIFEST "END\n\n"; + close MANIFEST or + &my_die("Unable to close dirinfo file $dirinfo", $dist_id, $PS_EXIT_UNKNOWN_ERROR); +} + +{ + my $command = "$disttool -updaterun -dist_id $dist_id -set_state full"; + $command .= " -set_outdir $outdir"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } +} + +exit 0; + +### Pau. + +sub stripvolume +{ + my $path = shift; + my $stage = shift; + my @segments; + + # workdir isn't what we want for raw stage + return "none" if ($stage and ($stage eq 'raw')); + + my $scheme = file_scheme($path); + my $tail; + if ($scheme) { + # strip off scheme:// + $tail = substr($path, length($scheme) + 3); + } elsif (substr($path, 0, 1) eq '/') { + $tail = substr($path, 1); + $scheme = ""; + } + # remove any leading / that are left + while ((substr($tail, 0, 1) eq '/')) { + $tail = substr($tail, 1); + } + + if (($scheme eq 'neb') or ($scheme eq 'path')) { + my $volume; + ($volume, @segments) = split '/', $tail; + + } elsif (!$scheme or ($scheme eq 'file')) { + + # XXX Here we're assuming the /data/ipp??? structure. This won't be true when data is forwarded + # by remote sites. We need a way to configure this + my $volume; + + # data/ippxxx/dirs + (undef, $volume, @segments) = split '/', $tail; + } else { + die( "unexpected workdir value: $path\n"); + } + + return caturi(@segments); +} + +sub find_componentdir +{ + my $destdir = shift; + my $path = shift; + + my $result; + if ($destdir eq 'none') { + $result = stripvolume($path); + } else { + # find location of destdir in the path + my $i = index($path, $destdir); + + $result = substr($path, $i + length($destdir) + 1); + + while (substr($result, 0, 1) eq '/') { + $result = substr($result, 1); + } + } + return dirname($result); +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $dist_id = shift; # Magic DS identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + my $command = "$disttool -updaterun"; + $command .= " -dist_id $dist_id"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $dist_id"); + } + } else { + print "Skipping command: $command\n"; + } + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_bundle.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_bundle.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_bundle.pl (revision 41105) @@ -0,0 +1,811 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +# print "\n\n"; +# print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile tempdir ); +use File::Basename qw( basename ); +use Digest::MD5::File qw( file_md5_hex ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# filerules that are not included in 'cleaned' distribution bundles +# I could simplify the function below by using a two level hash but +# that would be less clear I think +my %chip_cleaned = ( 'PPIMAGE.CHIP' => 'image', + 'PPIMAGE.CHIP.MASK' => 'mask', + 'PPIMAGE.CHIP.VARIANCE' => 'variance' ); +my %chip_bg_cleaned = ( 'PPBACKGROUND.OUTPUT' => 'image', + 'PPBACKGROUND.OUTPUT.MASK' => 'mask' ); +my %camera_cleaned = ( 'PSASTRO.OUTPUT.MASK' => 'mask' ); +my %fake_cleaned; +my %warp_cleaned = ( 'PSWARP.OUTPUT' => 'image', + 'PSWARP.OUTPUT.MASK' => 'mask', + 'PSWARP.OUTPUT.VARIANCE' => 'variance' ); +my %warp_bg_cleaned = ( 'PSWARP.OUTPUT' => 'image', + 'PSWARP.OUTPUT.MASK' => 'mask' ); +my %diff_cleaned = ( 'PPSUB.OUTPUT' => 'image', + 'PPSUB.OUTPUT.MASK' => 'mask', + 'PPSUB.OUTPUT.VARIANCE' => 'variance', + 'PPSUB.INVERSE' => 'inv_image', + 'PPSUB.INVERSE.MASK' => 'inv_mask', + 'PPSUB.INVERSE.VARIANCE' => 'inv_variance' ); + +my %stack_cleaned = ( 'PPSTACK.UNCONV' => 'image', + 'PPSTACK.UNCONV.MASK' => 'mask', + 'PPSTACK.UNCONV.VARIANCE' => 'variance', + 'PPSTACK.UNCONV.EXP' => 'exp', + 'PPSTACK.UNCONV.EXPNUM' => 'expnum', + 'PPSTACK.UNCONV.EXPWT' => 'expwt' + ); + +my %stack_convolved = ( 'PPSTACK.OUTPUT' => 'image', + 'PPSTACK.OUTPUT.MASK' => 'mask', + 'PPSTACK.OUTPUT.VARIANCE' => 'variance', + 'PPSTACK.OUTPUT.EXP' => 'exp', + 'PPSTACK.OUTPUT.EXPNUM' => 'expnum', + 'PPSTACK.OUTPUT.EXPWT' => 'expwt' + ); +my %empty_cleaned = (); + +# Look for programs we need +my $missing_tools; +my $streaksrelease = can_run('streaksrelease') or (warn "Can't find streaksrelease" and $missing_tools = 1); +my $bgtool = can_run('bgtool') or (warn "Can't find bgtool" and $missing_tools = 1); +my $staticskytool = can_run('staticskytool') or (warn "Can't find staticskytool" and $missing_tools = 1); +my $file_cmd = can_run('file') or (warn "can't find program file" and $missing_tools = 1); +my $zcat = can_run('zcat') or (warn "can't find program zcat" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($camera, $stage, $stage_id, $component, $path_base, $chip_path_base, $alt_path_base, $clean, $exp_type); +my ($outroot, $run_state, $data_state, $magicked, $no_magic, $poor_quality, $results_file, $prefix); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); + +GetOptions( + 'results_file=s' => \$results_file, # ouptput file name for results + 'camera=s' => \$camera, # camera for evaluating file rules + 'stage=s' => \$stage, # raw, chip, warp, or diff + 'stage_id=s' => \$stage_id, # exp_id, chip_id, warp_id, or diff_id + 'component=s' => \$component, # the class_id or skycell_id + 'path_base=s' => \$path_base, # path_base of the input + 'chip_path_base=s'=> \$chip_path_base, # path base for camera stage (to enable us to find the mask filefor raw images) + 'state=s' => \$run_state, # state of the run + 'data_state=s' => \$data_state, # data_state for this component + 'poor_quality' => \$poor_quality, # the processing for this component did not produced images + 'no_magic' => \$no_magic, # magic is not required for this distribution run + 'magicked' => \$magicked, # magicked state for this component + 'alt_path_base=s'=> \$alt_path_base, # path to alternate inputs + 'outroot=s' => \$outroot, # outroot + 'exp_type=s' => \$exp_type, # exp_type (only used for raw stage + 'prefix=s' => \$prefix, # "prefix" to apply to filenames + 'clean' => \$clean, # create clean distribution + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --camera --stage --stage_id --component --exp_type --path_base --outroot", + -exitval => 3) unless + defined $camera and + defined $stage and + defined $stage_id and + defined $component and + defined $path_base and + defined $outroot; + +$no_magic = 1; + +if ($stage eq 'raw' and !$clean and !$no_magic) { + + # for raw stage need to have exposure type defined and if the type is OBJECT we need + # a chip_path_base so we can find the chip mask file + if (!defined $exp_type or ($exp_type eq 'OBJECT' and !defined $chip_path_base)) { + pod2usage( -msg => "Required options: --chip_path_base --exp_type for raw stage", -exitval => 3); + } +} + +$ipprc->redirect_output($logfile) if $logfile; + +$ipprc->define_camera($camera); + +$ipprc->outroot_prepare($outroot); + +my $num_sky_inputs; +if ($stage eq 'sky') { + $num_sky_inputs = get_num_sky_inputs($stage_id); +} +# Get the list of data products for this component +# note: We my_die in get_file_list if something goes wrong. + +my $file_list = get_file_list($stage, $component, $path_base, $clean, $num_sky_inputs); + +if (($stage ne 'raw') and ($stage ne 'fake') and ($stage ne 'stack_summary') and !$poor_quality) { + # If the file list is empty it is an error because we should at least get a config dump file + # except for fake stage which doesn't do anything yet, stack_summary stage, and of course raw files have + # no config dump because they aren't processed + &my_die("empty file list", $component, $PS_EXIT_CONFIG_ERROR) if (!scalar @$file_list); +} + +# set up directory for temporary files + +my $temproot = metadataLookupStr($ipprc->{_siteConfig}, "TEMP.DIR"); +$temproot = "/tmp" if !defined $temproot; +&my_die("directory for TEMP.DIR $temproot does not exist", $component, $PS_EXIT_CONFIG_ERROR) if ! -e $temproot; + +my $tmpdir = tempdir("$temproot/dist.XXXX", CLEANUP => !$save_temps); + +# +# we need to run set masked pixels to NAN in the image and variance images +# unless +# 1. we are building a clean distribution bundle +# 2. magic is not required for this distRun +# 3. the processing for the component produced no images (warp or diff with bad quality for example) +my $nan_masked_pixels = ! ($clean || (($stage eq "camera") || ($stage eq 'fake') || ($stage eq 'stack') || ($stage eq 'sky')) || $no_magic || $poor_quality); + +my ($image, $mask, $variance); +my ($inv_image, $inv_mask, $inv_variance); + +my $num_files = 0; +foreach my $file (@$file_list) { + # check whether this file rule refers to an image, mask, or variance fits image + my $file_rule = $file->{file_rule}; + my $image_type = get_image_type($stage, $file_rule); + + # skip useless empty trace files + next if ($file_rule =~ /TRACE/); + + # if this is an image and we are building a clean bundle or if quality is bad skip this rule + next if $image_type and ($clean or $poor_quality); + + if ($stage eq 'stack') { + # skip convolved stacks since they are deleted just after they are created now + next if $stack_convolved{$file_rule}; + } + + # if magic is required, don't ship jpegs or binned fits images + next if !$no_magic && (($file_rule =~ /.BIN1/) or ($file_rule =~ /.BIN2/) or ($file_rule =~ /.JPEG1/) + or ($file_rule =~ /.JPEG2/)); + + if ($stage eq "diff") { + next if $file_rule =~ /CONV/; + ## exclude other products since not used any longer MEH 20190226 -- really should be a config option + #next if $file_rule =~ /STATS/; + #next if $file_rule =~ /LOG/; + #next if $file_rule =~ /TRACE/; + #next if $file_rule =~ /JPEG1/; + #next if $file_rule =~ /JPEG2/; + #next if $file_rule =~ /KERNELS/; + #next if $file_rule =~ /BACKMDL/; + #next if $file_rule =~ /PSF/; + #next if $file->{name} =~ /mdc/; + + } + if ($stage eq "SSdiff") { + next if $file_rule =~ /CONV/; + } + + my $file_name = $file->{name}; + + # look for file names that were processed remotely (LANL or UH Cray for example) + # and change them to nebulous names + if ( !($file_name =~ '^neb:') ) { + # XXX: These two definitions should probably live in a config file + my @remote_paths_to_replace = ('/lus/scratch/watersc', '/scratch3/watersc1'); + my $local_path = 'neb://any'; + # find filenames that begin with the remote paths and change them to a nebulous path + foreach my $remote_path (@remote_paths_to_replace) { + if ($file_name =~ "^$remote_path") { + $file_name =~ s{^$remote_path}{$local_path}; + last; + } + } + } + my $path = $ipprc->file_resolve($file_name); + + if (!$path and $file_rule =~ /LOG/) { + my $compressed_file_name = $file_name . '.bz2'; + my $compressed_path = $ipprc->file_resolve($compressed_file_name); + if ($compressed_path) { + $path = $compressed_path; + $file_name = $compressed_file_name; + } + } + + + if (!$path) { + # skip this file if $poor_quality + # this is for compatability with older runs which don't have the files list in the + # config dump. + # Once we give up on supporting that we can remove the next line. (If the file is in the list + # it must exist) + next if $poor_quality; + + # skip file stats file. Due to a bug the update process destroys them sometimes + # XXX: perhaps only do this for stages where we know that this happens + next if $file_rule =~ /STATS/; + # don't fail if these "non-essential files" are missing + next if $file_rule =~ /LOG/; + next if $file_rule =~ /TRACE/; + next if $file_rule =~ /BIN/; + + # chip stage cmf files are not regenerated after cleanup so don't complain if + # they are missing. They are of limited utility anyways. USE the smfs + next if ($stage eq 'chip' and $file_rule eq 'PSPHOT.OUTPUT'); + + &my_die("failed to resolve $file_name", $component, $PS_EXIT_DATA_ERROR); + } + + # open the file to make sure it exists (and to work around the failed mount phenomena) + my $fh = open_with_retries($path); + close $fh; + + # we need to pre-process the image before adding to the bundle. Save the path names. + # the images will be created below + $num_files++; + if ($image_type && $nan_masked_pixels) { + # save the + if ($image_type eq 'image') { + $image = $file_name; + } elsif ($image_type eq 'mask') { + $mask = $file_name; + } elsif ($image_type eq 'variance') { + $variance = $file_name;; + } elsif ($image_type eq 'inv_image') { + $inv_image = $file_name; + } elsif ($image_type eq 'inv_mask') { + $inv_mask = $file_name;; + } elsif ($image_type eq 'inv_variance') { + $inv_variance = $file_name;; + } elsif ($image_type eq 'inv_variance') { + $inv_variance = $file_name;; + } else { + &my_die("invalid image type found: $image_type", $component, + $PS_EXIT_PROG_ERROR); + } + } else { + # create a symbolic link from the file in the nebulous repository + # in the temporary directory + symlink $path, "$tmpdir/" . basename($file_name); + } +} + +if (!$clean) { + if ($stage eq 'chip_bg') { + # add the variance file from the original chipRun + my $command = "$bgtool -listchip -chip_bg_id $stage_id -class_id $component"; + $command .= " -dbname $dbname" if $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $list = $mdcParser->parse( join "", @$stdout_buf) or + &my_die("Unable to parse bgtool metadata", $component, $PS_EXIT_SYS_ERROR); + my $parsed = parse_md_list($list); + + # result is an array with one element + my $chip_data = $parsed->[0]; + + my $chip_path_base = $chip_data->{path_base}; + $variance = $ipprc->filename('PPIMAGE.CHIP.VARIANCE', $chip_path_base, $component) or + &my_die("Unable to resolve variance file name from $chip_path_base", $component, $PS_EXIT_SYS_ERROR); + + } elsif ($stage eq 'warp_bg') { + # add the variance file from the original warpRun + my $command = "$bgtool -listwarp -warp_bg_id $stage_id -skycell_id $component"; + $command .= " -dbname $dbname" if $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $list = $mdcParser->parse( join "", @$stdout_buf) or + &my_die("Unable to parse bgtool metadata", $component, $PS_EXIT_SYS_ERROR); + my $parsed = parse_md_list($list); + my $warp_data = $parsed->[0]; + my $warp_path_base = $warp_data->{path_base}; + $variance = $ipprc->filename('PSWARP.OUTPUT.VARIANCE', $warp_path_base) or + &my_die("Unable to resolve variance file name from $warp_path_base", $component, $PS_EXIT_SYS_ERROR); + } +} + +if ($nan_masked_pixels) { + # One last check as to whether magic has been applied to the inputs + + # Note: the sql for disttool -pendingcomponent won't select a component that + # requires magic and hasn't been magicked, but we check again here + + if (!($magicked or $no_magic or $alt_path_base)) { + &my_die("cannot create distribution bundle ${stage}_id $stage_id because the data has not been magic desreaked", $component, $PS_EXIT_DATA_ERROR); + } + + &my_die("no image found in file list", $component, $PS_EXIT_CONFIG_ERROR) if !$image; + if ($stage ne "raw") { + &my_die("no mask image found in file list", $component, $PS_EXIT_CONFIG_ERROR) if !$mask; + if (($stage ne "chip_bg") and ($stage ne "warp_bg")) { + &my_die("no variance image found in file list", $component, $PS_EXIT_CONFIG_ERROR) if !$variance; + } else { + &my_die("variance is not defined", $component, $PS_EXIT_CONFIG_ERROR) if !$variance; + } + } + + my $class_id; + # run streaksrelease to set masked pixels to NAN + if ($stage eq "raw") { + $class_id = $component; + # we can use the chip mask because disttool demands that magic have been run + # and so the camera mask and the chip mask are the same + #$mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $chip_path_base, $component); + # XXX: hack the pending query passes in the camera path base + $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $chip_path_base, $component); + my $mask_resolved = $ipprc->file_resolve($mask); + my $fh = open_with_retries($mask_resolved); + close $fh; + } elsif ($stage eq "chip" or $stage eq "chip_bg") { + $class_id = $component; + } + + my $release_stage; + if ($stage eq "chip_bg") { + $release_stage = 'chip'; + } elsif ($stage eq 'warp_bg') { + $release_stage = 'warp'; + } else { + $release_stage = $stage; + } + + + my $command = "$streaksrelease -stage $release_stage -image $image -outroot $tmpdir"; + $command .= " -class_id $class_id" if $class_id; + $command .= " -mask $mask" if $mask; + $command .= " -chip_mask $mask" if ($stage eq 'chip' and $mask); + $command .= " -weight $variance" if $variance; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + if ($inv_image) { + $command = "$streaksrelease -stage $release_stage -image $inv_image -outroot $tmpdir"; + $command .= " -mask $inv_mask" if $inv_mask; + $command .= " -weight $inv_variance" if $inv_variance; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + } +} + + +my $file_name; +my $bytes; +my $md5sum; + +if ($num_files) { + # create the tarfile +# my $tbase = basename($path_base); +# $tbase .= ".$component" if $component; +# $file_name = ($prefix ? $prefix : "") . "$tbase.tgz"; + my $error; + my $output_tarfile; + my $rule; + if ($stage eq 'chip' or $stage eq 'chip_bg' or $stage eq 'raw') { + $rule = "DIST.OUTPUT.CHIP.BUNDLE"; + } else { + $rule = "DIST.OUTPUT.BUNDLE"; + } + $output_tarfile = $ipprc->prepare_output($rule, $outroot, $component, 1, \$error) + or &my_die("Failed to prepare output tarfile: $error", $component, $error); + $file_name = basename($output_tarfile); + + + my $scheme = file_scheme($output_tarfile); + + my $tarfile; + if ($scheme) { + $ipprc->file_create($output_tarfile) + or &my_die("Failed to create $output_tarfile: $error", $component, $error); + $tarfile = $ipprc->file_resolve($output_tarfile); + + if ($scheme eq 'neb') { + &my_die("output file $output_tarfile not found", $component, $PS_EXIT_SYS_ERROR) + unless ($tarfile and -e $tarfile); + } + } else { + # no scheme the filename and the resolved filename are the same + $tarfile = $output_tarfile; + } + + my $command = "tar -C $tmpdir --owner=ipp --group=users -czhf $tarfile ."; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + + # tell the module not to die on error + $Digest::MD5::File::NOFATALS = 1; + $md5sum = file_md5_hex($tarfile); + &my_die("unable to compute md5sum for $tarfile", $component, $PS_EXIT_UNKNOWN_ERROR) if !$md5sum; + + $bytes = -s $tarfile; + + delete_tmpdir($tmpdir); +} else { + # no files for this component + # XXX: Does this ever happen? + $file_name = "none"; + $bytes = 0; + $md5sum = "0"; +} + +if ($results_file) { + open RF, ">$results_file" or &my_die("unable to open results file $results_file", $component, $PS_EXIT_UNKNOWN_ERROR); + print RF "bundleResults MULTI\n\n"; + print RF "bundleResults METADATA\n"; + print RF " name STR $file_name\n"; + print RF " bytes S64 $bytes\n"; + print RF " md5sum STR $md5sum\n"; + print RF "END\n\n"; + + close RF; +} + +exit 0; + +### Pau. + +# return the image type (image, mask, or variance) if this file rule refers to +# one of the big fits files that are not included in a clean distribution +sub get_image_type { + my $stage = shift; + my $rule = shift; + my $type; + + if ($stage eq "raw") { + if ($rule eq "RAW.IMAGE") { + $type = 'image'; + } + } elsif ($stage eq "chip") { + $type = $chip_cleaned{$rule}; + } elsif ($stage eq "chip_bg") { + $type = $chip_bg_cleaned{$rule}; + } elsif ($stage eq "camera") { + $type = $camera_cleaned{$rule}; + } elsif ($stage eq "fake") { + $type = $fake_cleaned{$rule}; + } elsif ($stage eq "warp") { + $type = $warp_cleaned{$rule}; + } elsif ($stage eq "warp_bg") { + $type = $warp_bg_cleaned{$rule}; + } elsif ($stage eq "diff") { + $type = $diff_cleaned{$rule}; + } elsif ($stage eq "SSdiff") { + $type = $diff_cleaned{$rule}; + } elsif ($stage eq "stack") { + $type = $stack_cleaned{$rule}; + } elsif ($stage eq "sky" or $stage eq "skycal" or $stage eq "stack_summary" or $stage eq "ff") { + $type = $empty_cleaned{$rule}; + } else { + &my_die("$stage is not a valid stage", $component, $PS_EXIT_CONFIG_ERROR); + } + return $type; +} + +sub open_with_retries { + my $name = shift; + + my $tries = 1; + my $max_tries = 5; + my $opened = 0; + while (!$opened && ($tries <= $max_tries)) { + $opened = open(IN, "<$name"); + if (!$opened) { + print STDERR "WARNING failed to open $name re-try $tries\n"; + $tries++; + sleep 5; + } + } + + &my_die("failed to open $name after $max_tries tries\n", $component, + $PS_EXIT_DATA_ERROR) if (!$opened); + + return *IN; +} + +sub get_file_list { + my $stage = shift; + my $component = shift; + my $path_base = shift; + my $clean = shift; + my $num_sky_inputs = shift; + + my @file_list; + if ($stage eq "raw") { + # raw files have no '.mdc' file thus we need to build the list of files by + # hand + # XXX do we want to distribute the registration log files? I vote no + if (!$clean) { + my %image; + $image{file_rule} = "RAW.IMAGE"; + my $image_name; + if ($alt_path_base) { + $image_name = "$alt_path_base.fits"; + } else { + $image_name = "$path_base.fits"; + } + $image{name} = $image_name; + push @file_list, \%image; + + if ($exp_type eq 'OBJECT' and $camera eq 'GPC1') { + my %burntool_table; + $burntool_table{file_rule} = "BURNTOOL.TABLE"; + $burntool_table{name} = "$path_base.burn.tbl"; + push @file_list, \%burntool_table; + } + } + return \@file_list; + } + + # we get the list of output data products for this run from the config dump file that + # is created when the run is done + my $config_file_rule; + if ($stage eq "chip") { + $config_file_rule = "PPIMAGE.CONFIG"; + } elsif ($stage eq "chip_bg") { + $config_file_rule = "PPBACKGROUND.CONFIG"; + } elsif ($stage eq "camera") { + $config_file_rule = "PSASTRO.CONFIG"; + } elsif ($stage eq 'fake') { + # XXX: fake is a no op now return an emtpy list + return \@file_list; + } elsif ($stage eq "warp") { + $config_file_rule = "PSWARP.CONFIG"; + } elsif ($stage eq "warp_bg") { + $config_file_rule = "PSWARP.CONFIG"; + } elsif ($stage eq "diff") { + $config_file_rule = "PPSUB.CONFIG"; + } elsif ($stage eq "SSdiff") { + $config_file_rule = "PPSUB.CONFIG"; + } elsif ($stage eq "stack") { + $config_file_rule = "PPSTACK.CONFIG"; + } elsif ($stage eq "sky") { + $config_file_rule = "PSPHOT.STACK.CONFIG"; + } elsif ($stage eq "skycal") { + $config_file_rule = "PSASTRO.CONFIG"; + } elsif ($stage eq "stack_summary") { + # stack_summary stage does not use a config dump file. + return build_stack_summary_file_list($path_base, \@file_list); + } elsif ($stage eq "ff") { + if ($component eq 'summary') { + # full force summary does not use a config dump file. Cobble together a file list + return build_ff_summary_file_list($path_base, \@file_list); + } else { + $config_file_rule = "PSPHOT.SKY.CONFIG"; + } + } else { + &my_die("$stage is not a valid stage", $component, $PS_EXIT_CONFIG_ERROR); + } + my $config_file = $ipprc->filename($config_file_rule, $path_base, $component) or + &my_die("can't get filename for config dump file: $config_file_rule", $component, + $PS_EXIT_CONFIG_ERROR); + + my %config_file_hash; + + # add the configuration file to the list + $config_file_hash{file_rule} = $config_file_rule; + $config_file_hash{name} = $config_file; + push @file_list, \%config_file_hash; + + my $resolved = $ipprc->file_resolve($config_file); + + if (!$resolved and $poor_quality) { + print STDERR "non config file found but continuing since component has poor quality\n"; + return undef + } + &my_die("failed to resolve name of config dump file: $config_file_rule", $component, + $PS_EXIT_CONFIG_ERROR) if (!$resolved); + + &my_die("config dump file resolved but not accessible: $config_file_rule", $component, + $PS_EXIT_CONFIG_ERROR) if !$ipprc->file_exists($resolved); + + my $mdc_compressed; + { + my $command = "$file_cmd $resolved"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + my $output = join "", @$stdout_buf; + # XXX: may need to to make this more robust + $mdc_compressed = ($output =~ /gzip/); + } + my $inName; + if ($mdc_compressed) { + my $tmpfile; + ($tmpfile, $inName) = tempfile( "/tmp/bundle.XXXX", UNLINK => !$save_temps ); + close($tmpfile) or &my_die("failed to close $inName", $component, $PS_EXIT_UNKNOWN_ERROR); + + my $command = "$zcat $resolved > $inName"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + + + } else { + $inName = $resolved; + } + my $in = open_with_retries($inName); + + # we don't use the mdc parser because the perl parser is way is too slow for complicated config + # files like this + my $line; + while ($line = <$in>) { + if ($line =~ /FILES.OUTPUT/) { + # print "found FILES.OUTPUT\n"; + last; + } + } + &my_die("config dump file does not contain FILES.OUTPUT: $config_file", $component, + $PS_EXIT_CONFIG_ERROR) if (!$line); + + while ($line = <$in>) { + chomp $line; + my ($key, $type, $val) = split " ", $line; + # skip blank lines + next if !$key; + # we're done when we find END + last if $key eq "END"; + # skip multi and other lines + next if ($type ne "STR"); + + # printf "%-32.32s %s\n", $key, $val; + + &my_die("no value found for file rule $key in $resolved", $component, + $PS_EXIT_CONFIG_ERROR) if (!$val); + + my %file; + $file{file_rule} = $key; + $file{name} = $val; + if ($val eq "STDERR" or $val eq "STDOUT") { + print STDERR "Skipping $key because filename is $val\n"; + next; + } + push @file_list, \%file; + } + close $in; + + return \@file_list; +} +sub get_num_sky_inputs { + my $sky_id = shift; + + my $command = "$staticskytool -inputs -sky_id $sky_id -simple"; + $command .= " -dbname $dbname" if $dbname; + $command .= " | wc"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + my ($num_inputs, $words, $chars) = split " ", (join "", @$stdout_buf); + if (!$num_inputs) { + $num_inputs = "undefined" if !defined $num_inputs; + &my_die("unexpected number of static sky inputs $num_inputs", $component, $error_code); + } + + return $num_inputs; +} + +# For stack_summary stage, we don't have a config dump file to give us the list of files. +# For now run neb-ls on the path base and take everything that matches. +sub build_stack_summary_file_list { + my ($path_base, $file_list) = @_; + + my $scheme = file_scheme($path_base); + + if (!$scheme or $scheme ne 'neb') { + &my_die("Building bundles for stack_summary not supported for no nebulous path_base.", + $component, $PS_EXIT_PROG_ERROR); + } + + my $command = "neb-ls $path_base" . '%'; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + my $nebls_output = join "", @$stdout_buf; + + my @files = split "\n", $nebls_output; + + my $i = 0; + foreach my $f (@files) { + my %file; + $file{file_rule} = sprintf 'RULE.%d', $i++; + $file{name} = 'neb://any/' . $f; + push @$file_list, \%file; + } + + return $file_list; +} + +# psphotFullForceSummary does not produce a config dump file cobble together a file list +sub build_ff_summary_file_list { + my ($path_base, $file_list) = @_; + + my %cmf ; + $cmf{file_rule} = "SOURCES"; + $cmf{name} = "$path_base.cmf"; + push @$file_list, \%cmf; + + my %log; + $log{file_rule} = "LOG"; + $log{name} = "$path_base.log"; + push @$file_list, \%log; + + return $file_list; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $component = shift; # class_id or skycell_id + my $exit_code = shift; # Exit code to add + + delete_tmpdir(); + + carp($msg); + exit $exit_code; +} + +sub delete_tmpdir +{ + if (!$save_temps and $tmpdir and -e $tmpdir) { + system "rm -r $tmpdir"; + } +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_cleanup.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_cleanup.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_cleanup.pl (revision 41105) @@ -0,0 +1,210 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( dirname); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($dist_id, $stage, $stage_id, $outdir); +my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile); + +GetOptions( + 'dist_id=s' => \$dist_id,# Magic destreak run identifier + 'stage=s' => \$stage, # raw, chip, warp, or diff + 'stage_id=s' => \$stage_id, # exp_id, chip_id, warp_id, or diff_id + 'outdir=s' => \$outdir, # "directory" for outputs + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dist_id --stage --stage_id --outdir", + -exitval => 3) unless + defined $dist_id and + defined $stage and + defined $stage_id and + defined $outdir; + +$ipprc->redirect_output($logfile) if $logfile; + +# Look for programs we need +my $missing_tools; +my $disttool = can_run('disttool') or (warn "Can't find disttool" and $missing_tools = 1); +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +if ($missing_tools) { + &my_die("Can't find required tools.", $dist_id, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; + +my $filesets; +{ + my $command = "$disttool -listfilesets -dist_id $dist_id"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } + my $stdout = join "", @$stdout_buf; + if ($stdout) { + my $metadata = $mdcParser->parse ($stdout) or + &my_die("Unable to parse metadata config doc", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + + $filesets = parse_md_list($metadata); + } +} + +foreach my $fileset (@$filesets) { + my $fs_id = $fileset->{fs_id}; + my $name = $fileset->{fileset}; + my $product = $fileset->{product}; + my $ds_dbname = $fileset->{dbname}; + my $ds_dbserver = $fileset->{dbhost}; + my $command = "$dsreg --del $name --product $product --rm --force"; + $command .= " --ds_dbname $ds_dbname" if defined $ds_dbname; + $command .= " --ds_dbserver $ds_dbserver" if defined $ds_dbserver; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $stderr = join "", @$stderr_buf; + # fail unless error message says "not found" + if (!$stderr =~ /not found/) { + print STDERR $stderr; + &my_die("failed to delete fileset $name from $product: $error_code", $dist_id, $error_code); + } + } + { + my $command = "$disttool -updatefileset -fs_id $fs_id -set_state cleaned"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } + } +} + +# XXX should we create file rules for these? +my $dbinfo_file = "$outdir/dbinfo.$stage.$stage_id.mdc"; +my $dirinfo_file = "$outdir/dirinfo.$stage.$stage_id.mdc"; + +zap_it($ipprc, $dbinfo_file); +zap_it($ipprc, $dirinfo_file); + +my $files; +{ + my $command = "$disttool -processedcomponent -dist_id $dist_id"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } + my $stdout = join "", @$stdout_buf; + if ($stdout) { + my $metadata = $mdcParser->parse ($stdout) or + &my_die("Unable to parse metadata config doc", $dist_id, $error_code); + + $files = parse_md_list($metadata); + } +} + +foreach my $file (@$files) { + my $outdir = $file->{outdir}; + my $name = "$outdir/" . $file->{name}; + + zap_it($ipprc, $name); +} + +{ + my $command = "$disttool -updaterun -dist_id $dist_id -set_state cleaned"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $error_code); + } +} + + +exit 0; + +### Pau. + +sub zap_it { + my $ipprc = shift; + my $name = shift; + + if ($ipprc->file_exists($name)) { + $ipprc->file_delete($name) or my_die("failed to delete $name", $dist_id, $PS_EXIT_UNKNOWN_ERROR); + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $dist_id = shift; # distRun identifier + my $exit_code = shift; # fault code + + # replace exit code if it's nonzero + $exit_code = $PS_EXIT_PROG_ERROR unless $exit_code; + + my $command = "$disttool -updaterun"; + $command .= " -dist_id $dist_id"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $dist_id"); + } + } else { + print "Skipping command: $command\n"; + } + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_component.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_component.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_component.pl (revision 41105) @@ -0,0 +1,212 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Digest::MD5::File qw( file_md5_hex ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $disttool = can_run('disttool') or (warn "Can't find disttool" and $missing_tools = 1); +my $dist_make_bundle = can_run('dist_bundle.pl') or (warn "Can't find dist_bundle.pl" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($dist_id, $camera, $stage, $stage_id, $component, $path_base, $chip_path_base, $clean, $alt_path_base); +my ($outdir, $run_state, $data_state, $magicked, $no_magic, $poor_quality, $exp_type, $rerun); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); + +GetOptions( + 'dist_id=s' => \$dist_id, # distribution run identifier + 'camera=s' => \$camera, # camera for evaluating file rules + 'stage=s' => \$stage, # raw, chip, warp, or diff + 'stage_id=s' => \$stage_id, # exp_id, chip_id, warp_id, or diff_id + 'component=s' => \$component, # the class_id or skycell_id + 'path_base=s' => \$path_base, # path_base of the input + 'chip_path_base=s'=> \$chip_path_base, # path base for camera stage (to enable us to find the mask filefor raw images) + 'state=s' => \$run_state, # state of the run + 'data_state=s' => \$data_state, # data_state for this component + 'poor_quality' => \$poor_quality, # the processing for this component did not produced images + 'no_magic' => \$no_magic, # magic is not required for this distribution run + 'magicked' => \$magicked, # magicked state for this component + 'exp_type=s' => \$exp_type, + 'alt_path_base=s'=> \$alt_path_base, # path to alternate inputs + 'outdir=s' => \$outdir, # "directory" for outputs + 'clean' => \$clean, # create clean distribution + 'rerun' => \$rerun, # recreate an existing component and update the database + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dist_id --camera --stage --stage_id --component --path_base --outdir", + -exitval => 3) unless + defined $dist_id and + defined $camera and + defined $stage and + defined $stage_id and + defined $component and + defined $path_base and + defined $outdir; + +my $ipprc = PS::IPP::Config->new($camera); # IPP configuration +$ipprc->redirect_to_logfile($logfile) if $logfile; + +my $temproot = metadataLookupStr($ipprc->{_siteConfig}, "TEMP.DIR"); + +$temproot = "/tmp" if !defined $temproot; + +if (($stage eq 'raw') and !$clean and !(defined $chip_path_base and defined $exp_type)) { + pod2usage( -msg => "Required options: --chip_path_base --exp_type for raw stage", -exitval => 3); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my ($rf, $rf_name) = tempfile("$temproot/bundleresults.$dist_id.$component.XXXX", UNLINK => !$save_temps); +close $rf; + +my $basename = basename($path_base); +my $outroot = "$outdir/$basename"; + +my ($file_name, $bytes, $md5sum); +{ + my $command = "$dist_make_bundle --camera $camera --stage $stage --stage_id $stage_id"; + $command .= " --results_file $rf_name"; + $command .= " --component $component --path_base $path_base --outroot $outroot"; + $command .= " --chip_path_base $chip_path_base" if $chip_path_base; + $command .= " --state $run_state" if defined $run_state; + $command .= " --data_state $data_state" if defined $data_state; + $command .= " --poor_quality" if defined $poor_quality; + $command .= " --no_magic" if defined $no_magic; + $command .= " --magicked" if defined $magicked; + $command .= " --alt_path_base $alt_path_base" if defined $alt_path_base; + $command .= " --exp_type $exp_type" if defined $exp_type; + $command .= " --clean" if defined $clean; + $command .= " --save-temps" if defined $save_temps; + $command .= " --dbname $dbname" if defined $dbname; + $command .= " --verbose" if defined $verbose; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $component, $outdir, $error_code); + } + + open $rf, "<$rf_name" or &my_die("failed to open results file $rf_name", $dist_id, $component, $outdir, $PS_EXIT_UNKNOWN_ERROR); + + my @lines = (<$rf>); + + my $metadata = $mdcParser->parse (join "", @lines) or + &my_die("Unable to parse metadata config doc", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + + my $results = parse_md_list($metadata); + + if ((scalar @$results) != 1) { + my $n = scalar @$results; + &my_die("Unexected number of results from dist_make_bundle.pl: $n", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + } + my $result = $results->[0]; + + $file_name = $result->{name}; + &my_die("undefined file name from dist_bundle.pl", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR) unless defined $file_name; + + $bytes = $result->{bytes}; + &my_die("undefined file size from dist_bundle.pl", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR) unless defined $bytes; + + $md5sum = $result->{md5sum}; + &my_die("undefined file md5sum from dist_bundle.pl", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR) unless defined $md5sum; +} + + +{ + my $command; + if (!$rerun) { + $command = "$disttool -addprocessedcomponent"; + } else { + $command = "$disttool -updateprocessedcomponent"; + } + + $command .= " -dist_id $dist_id -component $component -outdir $outdir"; + $command .= " -name $file_name -bytes $bytes -md5sum $md5sum"; + $command .= " -dbname $dbname" if defined $dbname; + + unless (defined $no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $component, $outdir, $error_code); + } + } else { + print "skipping command $command\n"; + } +} + +exit 0; + +### Pau. +sub my_die +{ + my $msg = shift; # Warning message on die + my $dist_id = shift; # distRun.dist_id + my $component = shift; # class_id, skycell_id, or exposure + my $outdir = shift; # output directory + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + my $command; + if (!$rerun) { + $command = "$disttool -addprocessedcomponent"; + } else { + $command = "$disttool -updateprocessedcomponent"; + } + $command .= " -dist_id $dist_id"; + $command .= " -component $component"; + $command .= " -outdir $outdir"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $dist_id $component"); + } + } else { + print "Skipping command: $command\n"; + } + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_defineruns.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_defineruns.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_defineruns.pl (revision 41105) @@ -0,0 +1,150 @@ +#!/usr/bin/env perl +# +# dist_queue_runs.pl : run disttool -definebyquery for the various stages or one stage +# + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Digest::MD5::File qw( file_md5_hex ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Look for programs we need +my $missing_tools; +my $disttool = can_run('disttool') or (warn "Can't find disttool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($stage, $stage_limit, $dist_root, $workdir, $no_magic, $rerun); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); +my @labels; + +GetOptions( + 'stage=s' => \$stage, # stage to queue + 'label=s' => \@labels, # labels + 'workdir=s' => \$workdir, # workdir + 'stage_limit=s' => \$stage_limit,# maximum number of runs queued for each stage + 'rerun' => \$rerun, # queue new runs even if one exists +# 'dist_root=s' => \$dist_root, # root of distribution work area + 'no_magic' => \$no_magic, # queue runs without requiring magic (for testing only) + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database + 'pretend' => \$no_update, # Don't update the database + 'save-temps' => \$save_temps, # Save temporary files? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --label", + -exitval => 3) unless + (scalar @labels > 0); + +$ipprc->redirect_output($logfile) if $logfile; + +if (!$workdir) { + print "workdir not supplied will use DISTRIBUTION_ROOT\n"; + # old method where we set workdir based on a config file + if (!$dist_root) { + $dist_root = metadataLookupStr($ipprc->{_siteConfig}, "DISTRIBUTION_ROOT"); + &my_die("failed to find DISTRIBUTION_ROOT in site configuration", $PS_EXIT_CONFIG_ERROR) if !$dist_root; + } + + my ($day, $month, $year) = (gmtime)[3,4,5]; + my $datestr = sprintf "%04d%02d%02d", $year+1900, $month + 1, $day; + + $workdir = $dist_root . "/$datestr"; + + print "workdir is $workdir\n"; +} + +# if stage is not supplied as an argument, loop over all stages +my @stages; +if ($stage) { + push @stages, $stage; +} else { + @stages = qw(chip chip_bg camera fake warp warp_bg diff stack SSdiff sky skysingle ff); +} + +foreach my $stage (@stages) { + foreach my $label (@labels) { + my $single; + my $cmdstage; + if ($stage eq "skysingle") { + $cmdstage = "sky"; + $single = 1; + } else { + $cmdstage = $stage; + } + my $command = "$disttool -definebyquery -stage $cmdstage -workdir $workdir -label $label"; + $command .= " -singlefilter" if $single; + $command .= " -no_magic" if $no_magic; + $command .= " -rerun" if $rerun; + $command .= " -pretend" if $no_update; + $command .= " -limit $stage_limit" if $stage_limit; + $command .= " -set_label $label"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $error_code); + } + # display the output from the command + print STDERR join "", @$stdout_buf if $verbose; + } +} + +if (0) { +# notyet +# queue rcRuns for any distRuns that have completed and have interested destinations + my $command = "$disttool -queuercrun"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $error_code); + } + # display the output from the command + print STDERR join "", @$stdout_buf if $verbose; +} + +exit 0; + +sub my_die { + my $msg = shift; + my $fault = shift; + + print STDERR "$msg\n"; + + exit $fault; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_fix_file.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_fix_file.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_fix_file.pl (revision 41105) @@ -0,0 +1,234 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +#print "\n\n"; +#print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Digest::MD5::File qw( file_md5_hex ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use DBI; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $disttool = can_run('disttool') or (warn "Can't find disttool" and $missing_tools = 1); +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $dist_component = can_run('dist_component.pl') or (warn "Can't find dist_component.pl" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($dist_id, $camera, $component ); +my ($outdir, $run_state, $data_state, $magicked, $poor_quality, $exp_type, $rerun); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); + +$camera = 'GPC1'; + +GetOptions( + 'dist_id=s' => \$dist_id, # distribution run identifier + 'component=s' => \$component, # the class_id or skycell_id + 'camera=s' => \$camera, # the class_id or skycell_id + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dist_id --camera --component", + -exitval => 3) unless + defined $dist_id and + defined $camera and + defined $component; + +my $ipprc = PS::IPP::Config->new($camera); # IPP configuration +$ipprc->redirect_to_logfile($logfile) if $logfile; + +my $dbh = getDBHandle() unless $no_update; + +my $temproot = metadataLookupStr($ipprc->{_siteConfig}, "TEMP.DIR"); + +$temproot = "/tmp" if !defined $temproot; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +$disttool .= " -dbname $dbname" if $dbname; +$regtool .= " -dbname $dbname" if $dbname; + +my $comp = get_distcomponent($dist_id, $component); + +my $stage = $comp->{stage}; +my $stage_id = $comp->{stage_id}; +my $no_magic = $comp->{no_magic}; +my $path_base; +my $stage_args = ""; +if ($stage eq 'raw') { + # need path_base (get from uri) + # exp_type + # no_magic + # camera path base if !$no_magic + my $command = "$regtool -processedimfile -exp_id $stage_id -class_id $component"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $component, $outdir, $error_code); + } + + my $metadata = $mdcParser->parse (join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + + my $results = parse_md_list($metadata); + + if ((scalar @$results) != 1) { + my $n = scalar @$results; + &my_die("Unexected number of results from regtool -processedimfile: $n", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + } + my $rawfile = $results->[0]; + $path_base = $rawfile->{uri}; + $path_base =~ s/.fits//; + my $exp_type = $rawfile->{exp_type}; + if (!$no_magic) { + die "don't know how to create magicked raw bundles yet\n"; + } + $stage_args .= " --exp_type $exp_type --chip_path_base NULL"; + $stage_args .= " --no_magic" if $no_magic; +} else { + + die "not ready for stage $stage yet\n"; +} +my $dist_cmd = "$dist_component --rerun --camera $camera --dist_id $dist_id --stage $stage --stage_id $stage_id --component $component --outdir $comp->{outdir} --path_base $path_base $stage_args"; + +$dist_cmd .= " --dbname $dbname" if $dbname; +$dist_cmd .= " --verbose" if $verbose; +$dist_cmd .= " --no-update" if $no_update; + +print "$dist_cmd\n"; + +$comp = get_distcomponent($dist_id, $component); + +my $bytes = $comp->{bytes}; +my $md5sum = $comp->{md5sum}; +my $name = $comp->{name}; + + +my $query = "UPDATE dsFile join dsFileset using(fileset_id) join dsProduct USING(prod_id) SET dsFile.bytes =?, dsFile.md5sum = ? WHERE prod_name = ? AND fileset_name = ? AND file_name = ?"; + +my $stmt = $dbh->prepare($query); + +my $filesets = get_filesets($dist_id); + +foreach my $fs (@$filesets) { + my $product = $fs->{product}; + my $fileset = $fs->{fileset}; + $stmt->execute($bytes, $md5sum, $product, $fileset, $name) or + &my_die("failed to update dsFile for $product $fileset $name\n", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + + print "Updated dsFile for $product $fileset $name $bytes $md5sum\n"; +} + + +exit 0; + +sub getDBHandle { + my $dbserver = metadataLookupStr($ipprc->{_siteConfig}, "DS_DBSERVER"); + my $dbuser = metadataLookupStr($ipprc->{_siteConfig}, "DS_DBUSER"); + my $dbpassword = metadataLookupStr($ipprc->{_siteConfig}, "DS_DBPASSWORD"); + my $dbname = metadataLookupStr($ipprc->{_siteConfig}, "DS_DBNAME"); + + &my_die("database configuration not set up", $dist_id, $component, $outdir, $PS_EXIT_UNKNOWN_ERROR) unless defined($dbserver) and defined($dbuser) + and defined($dbpassword) and defined($dbname); + + my $dsn = "DBI:mysql:host=$dbserver;database=$dbname"; + + my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) + or die "Cannot connect to database $dbname on $dbserver.\n"; + + return $dbh; +} + + + +sub get_distcomponent { + my $dist_id = shift; + my $component = shift; + my $command = "$disttool -processedcomponent -dist_id $dist_id -component $component"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $component, $outdir, $error_code); + } + + my $metadata = $mdcParser->parse (join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + + my $results = parse_md_list($metadata); + + if ((scalar @$results) != 1) { + my $n = scalar @$results; + &my_die("Unexected number of results from disttool -processedcomponent: $n", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + } + return $results->[0]; +} + +sub get_filesets { + my $dist_id = shift; + my $command = "$disttool -listfilesets -dist_id $dist_id"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $dist_id, $component, $outdir, $error_code); + } + + my $output = join "", @$stdout_buf; + if (!$output) { + return undef; + } + my $metadata = $mdcParser->parse ($output) or + &my_die("Unable to parse metadata config doc", $dist_id, $component, $outdir, $PS_EXIT_PROG_ERROR); + + my $results = parse_md_list($metadata); + + return $results +} + + +### Pau. +sub my_die +{ + my $msg = shift; # Warning message on die + my $dist_id = shift; # distRun.dist_id + my $component = shift; # class_id, skycell_id, or exposure + my $outdir = shift; # output directory + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_make_fileset.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_make_fileset.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dist_make_fileset.pl (revision 41105) @@ -0,0 +1,293 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Digest::MD5::File qw( file_md5_hex ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Look for programs we need +my $missing_tools; +my $disttool = can_run('disttool') or (warn "Can't find disttool" and $missing_tools = 1); +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($dist_id, $dist_dir, $target_id, $stage, $stage_id, $dest_id, $product_name, $ds_dbhost, $ds_dbname); +my ($label, $data_group, $filter); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); + +GetOptions( + 'dist_id=s' => \$dist_id, # distribution run identifier + 'dist_dir=s' => \$dist_dir, # directory containing dist run outputs + 'target_id=s' => \$target_id, # + 'stage=s' => \$stage, # raw, chip, camera, fake, warp, stack, or diff + 'stage_id=s' => \$stage_id, # exp_id, chip_id, etc. + 'dest_id=s' => \$dest_id, # id for the product + 'product_name=s' => \$product_name, # location of the data store directory for this product + 'label=s' => \$label, + 'data_group=s' => \$data_group, + 'filter=s' => \$filter, + 'ds_dbhost=s' => \$ds_dbhost, # database host for the datastore database + 'ds_dbname=s' => \$ds_dbname, # database name for the datastore database + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dist_id --dist_dir --target_id --stage --stage_id --data_group --filter --dest_id --ds_dbhost --ds_dbname", + -exitval => 3) unless + defined $dist_id and + defined $dist_dir and + defined $target_id and + defined $stage and + defined $stage_id and + defined $data_group and + defined $filter and + defined $dest_id and + defined $product_name and + defined $ds_dbhost and + defined $ds_dbname; + +$ipprc->redirect_output($logfile) if $logfile; + + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my $fs_tag = get_fileset_tag($ipprc, $stage, $stage_id, $dbname); + +&my_die("failed to lookup fileset tag", $dist_id, $dest_id, $PS_EXIT_UNKNOWN_ERROR) if !defined $fs_tag; + +my $fileset_name = $fs_tag ? "$fs_tag." : ""; +$fileset_name .= "$stage.$stage_id.$dist_id.$dest_id"; + +print "$fileset_name\n"; + + +# make sure that the database info file for this run exists +my $dbinfo_file = "$dist_dir/dbinfo.$stage.$stage_id.mdc"; +if (! $ipprc->file_exists($dbinfo_file) ) { + &my_die("dbinfo file for dist run $dbinfo_file not found", $dist_id, $dest_id, $PS_EXIT_UNKNOWN_ERROR); +} +print "dbinfo file $dbinfo_file exists\n" if $verbose; + +# make sure that the dirinfo file for this run exists +my $dirinfo_file = "$dist_dir/dirinfo.$stage.$stage_id.mdc"; +if (!$ipprc->file_exists($dirinfo_file)) { + &my_die("dirinfo file for dist run $dirinfo_file not found", $dist_id, $dest_id, $PS_EXIT_UNKNOWN_ERROR); +} +print "dirinfo file $dirinfo_file exists\n" if $verbose; + +# open the dsreg file list +my ($listFile, $listFileName) = tempfile("/tmp/$stage.$stage_id.list.XXXX", UNLINK => !$save_temps ); + +# add the dbinfo file to the list +# XXX: change type from text to dbinfo and dirinfo once we define the types +print $listFile "$dbinfo_file|||text|dbinfo|\n"; +print $listFile "$dirinfo_file|||text|dirinfo|\n"; + +my $components; +{ + my $command = "$disttool -processedcomponent -dist_id $dist_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $dist_id, $dest_id, $error_code); + } + + my $metadata = $mdcParser->parse (join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $dist_id, $dest_id, $PS_EXIT_PROG_ERROR); + + $components = parse_md_list($metadata); + + my $num_components = scalar @$components; + + print "distRun $dist_id has $num_components components\n"; +} + +foreach my $component (@$components) { + my $size = $component->{bytes}; + # skip zero size components. They are placeholders to complete processing + next if $size == 0; + my $md5sum = $component->{md5sum}; + # name of the file + my $file_name = $component->{name}; + # component id (class_is or skycell_id) + my $comp_dir = $component->{outdir}; + my $comp_name = $component->{component}; + + # XXX: if tarfile is not always the right type we need to add a type to distComponent + print $listFile "$comp_dir/$file_name|$size|$md5sum|tgz|$comp_name|\n"; +} + +close $listFile; + +{ + my $command = "$dsreg --add $fileset_name --product $product_name --type IPP-DIST --list $listFileName"; + + # the data store will refer to the distribution bundle via symlinks back to distRun.outdir +# $command .= " --datapath $dist_dir --link"; + $command .= " --abspath --link"; + + # set the product specific columns in product list + my $prod_col_3 = $fs_tag ? $fs_tag : "$stage.$stage_id"; + + $command .= " --ps0 $target_id --ps1 $stage --ps2 $stage_id --ps3 $prod_col_3"; + $command .= " --ps4 $data_group --ps5 $filter"; + + $command .= " --dbname $ds_dbname --dbhost $ds_dbhost"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $dist_id, $dest_id, $error_code); + } +} + +{ + my $command = "$disttool -addfileset -dist_id $dist_id -dest_id $dest_id -name $fileset_name"; + $command .= " -dbname $dbname" if $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + # XXX: if we get here we the fileset has been created but the database update failed + # We need to have revertfileset check whether the fileset exists and do dsreg -del if it does + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $dist_id, $dest_id, $error_code); + } +} + + + +exit 0; + +sub getDBHandle { + my $ipprc = shift; + my $dbname = shift; + if (!$dbname) { + $dbname = metadataLookupStr($ipprc->{_siteConfig}, "DBNAME"); + } + my $dbserver = metadataLookupStr($ipprc->{_siteConfig}, "DBSERVER"); + my $dbuser = metadataLookupStr($ipprc->{_siteConfig}, "DBUSER"); + my $dbpassword = metadataLookupStr($ipprc->{_siteConfig}, "DBPASSWORD"); + + die "database configuration not set up" unless defined($dbserver) and defined($dbuser) + and defined($dbpassword) and defined($dbname); + + my $dsn = "DBI:mysql:host=$dbserver;database=$dbname"; + + my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) + or die "Cannot connect to database.\n"; + + return $dbh; +} + + +sub get_fileset_tag { + my $ipprc = shift; + my $stage = shift; + my $stage_id = shift; + my $dbname = shift; + + if (($stage eq 'stack') or ($stage eq 'diff') or ($stage eq 'SSdiff') or $stage eq 'sky' or $stage eq 'skycal' or $stage eq "ff") { + return ""; + } + + # + # we are a long ways away from the rawExp in the pipeline. Rather than do some + # very long joins in disttool, we look up the exp_name in the database using DBI + # + my $dbh = getDBHandle($ipprc, $dbname); + + my $query; + + if ($stage eq 'raw') { + $query = "SELECT exp_name FROM rawExp WHERE exp_id = $stage_id"; + } elsif ($stage eq 'chip') { + $query = "SELECT exp_name FROM chipRun JOIN rawExp USING(exp_id) WHERE chip_id = $stage_id"; + } elsif ($stage eq 'chip_bg') { + $query = "SELECT exp_name FROM chipBackgroundRun JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) WHERE chip_bg_id = $stage_id"; + } elsif ($stage eq 'camera') { + $query = "SELECT exp_name FROM camRun JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id)" + . " WHERE cam_id = $stage_id"; + } elsif ($stage eq 'fake') { + $query = "SELECT exp_name FROM fakeRun JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id)" + . " JOIN rawExp USING(exp_id) WHERE fake_id = $stage_id"; + } elsif ($stage eq 'warp') { + $query = "SELECT exp_name FROM warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id)" + . " JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) WHERE warp_id = $stage_id"; + } elsif ($stage eq 'warp_bg') { + $query = "SELECT exp_name FROM warpBackgroundRun JOIN warpRun USING(warp_id) JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) WHERE warp_bg_id = $stage_id"; + + } else { + &my_die("$stage is invalid value for stage", $dist_id, $dest_id, $PS_EXIT_UNKNOWN_ERROR); + } + + my $stmt = $dbh->prepare($query); + $stmt->execute(); + my $ref = $stmt->fetchrow_hashref(); + + my $tag = $ref->{exp_name}; + + return "$tag"; +} + +sub my_die { + my $msg = shift; + my $dist_id = shift; + my $dest_id = shift; + my $fault = shift; + + # TODO: disttool -adddsfileset -dest_id $dest_id -dist_id $dist_id -fault $fault + print STDERR "$msg\n"; + + my $command = "$disttool -addfileset -dist_id $dist_id -dest_id $dest_id -fault $fault"; + $command .= " -dbname $dbname" if $dbname; + + if (!$no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + print STDERR "Unable to perform $command error_code: $error_code\n"; + } + } else { + print STDERR "skipping $command\n"; + } + exit $fault; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dqstats_bundle.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dqstats_bundle.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/dqstats_bundle.pl (revision 41105) @@ -0,0 +1,163 @@ +#! /usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dqstatstool = can_run('dqstatstool') or (warn "Can't find dqstatstool" and $missing_tools = 1); +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $dqstats_id, $camera, $uri, $dbname, $verbose, $no_update, $no_op, $redirect, $save_temps); +GetOptions( + 'dqstats_id=s' => \$dqstats_id, # dqstatsrun ID + 'camera|c=s' => \$camera, # camera + 'dbname|d=s' => \$dbname, # database name + 'uri=s' => \$uri, # output file destination + 'verbose' => \$verbose, # print to stdout + 'no-update' => \$no_update, # Update the database + 'no-op' => \$no_op, # don't do the operations + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # save temporary files + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options --dqstats_id --camera", + -exitval => 3, + ) unless + defined $dqstats_id and + defined $camera; + +my $ipprc = PS::IPP::Config->new( $camera ) + or my_die( "Unable to set up", $dqstats_id, $PS_EXIT_CONFIG_ERROR ); # IPP config +#my $logDest = $ipprc->filename("LOG.EXP", $uri) +# or my_die("Missing entry from camera config", $dqstats_id, $PS_EXIT_CONFIG_ERROR); + +if ($redirect) { +# $ipprc->redirect_output($logDest) +# or my_die( "Unable to redirect output", $dqstats_id, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Output products +unless (defined($uri)) { + $uri = "/tmp/dqstats.${dqstats_id}.fits"; +} +#$ipprc->outroot_prepare($uri); # hm....need to think more here. + +my $bundle_command = "$dqstatstool -dbname $dbname -createbundle "; +$bundle_command .= "-dqstats_id $dqstats_id "; +$bundle_command .= "-uri $uri "; + +my $filesetID = "dqstats.${dqstats_id}"; + +unless ($no_op) { + # This bit needs to make the bundle. + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $bundle_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + unlink($uri); + &my_die("Unable to create the bundle.: $error_code", $dqstats_id, $error_code); + } + + # Parse stdout_buf to get output file name + ## Begin partial + my ($tempFile, $tempName) = tempfile( "/tmp/dqstats.XXXX", + UNLINK => !$save_temps, SUFFIX => 'dsin' ); + print $tempFile $uri . '|||notset' . "\n"; + + my $register_cmd = "$dsreg --product 'DQstats' --add $filesetID --type table --list $tempName --abspath --copy"; + + # It can't be that simple, can it? This should probably add a fault on failure. + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $register_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + unlink($uri); + &my_die("Unable to register the bundle.: $error_code", $dqstats_id, $error_code); + } + + # We no longer need the file generated by dqstatstool. + unlink($uri); +} + +my $update_command = "$dqstatstool -dbname $dbname -dqstats_id $dqstats_id"; +$update_command .= " -updaterun -set_state 'full' "; + +unless ($no_update) { + # This bit needs to set the database state to full + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $update_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to add result to database: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $update_command\n"; +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $dqstats_id = shift; # Camtool identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $dqstats_id and not $no_update) { + # There is no fault handling, which may be a mistake. This is where a fault coding would be. +# my $command = "$addtool -add_id $add_id"; +# $command .= " -addprocessedexp"; +# $command .= " -fault $exit_code"; +# $command .= " -path_base $outroot" if defined $outroot; +# $command .= (" -dtime_addstar " . ((DateTime->now->mjd - $mjd_start) * 86400)); +# $command .= " -dbname $dbname" if defined $dbname; +# system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ds9_cmf_regions.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ds9_cmf_regions.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ds9_cmf_regions.pl (revision 41105) @@ -0,0 +1,172 @@ +#!/usr/bin/env perl + +use strict; +use Astro::FITS::CFITSIO qw( :constants ); +use File::Temp qw( tempfile ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use Data::Dumper; +use Carp; + +Astro::FITS::CFITSIO::PerlyUnpacking(1); + +my $xpaset = `which xpaset`; +my $xpaget = `which xpaget`; + +die "Unable to find xpaget and xpaset.\n" unless ($xpaset =~ /\S+/ and $xpaget =~ /\S+/); + + +my ( $filename, # Filename containing photometry + $extname, # Extension name containing photometry + $frame, # Frame number in ds9 + $colour, # Region colour + $flag_colour, # Flagged source region colour + $flag, # Flags + $mag_radius, # Magnitude scaling for radius? + $radius, # Radius for circle + $save_temps + ); + +# Defaults +$colour = "blue"; +$flag_colour = "red"; +$radius = 5; +$flag = (8 | # FAIL + 1024 | # BADPSF + 2048 | # DEFECT + 4096 | # SATURATED + 8192 | # CR_LIMIT + 65536 # SKY_FAILURE + ); + +GetOptions( + 'file=s' => \$filename, + 'ext=s' => \$extname, + 'frame=s' => \$frame, + 'colour=s' => \$colour, + 'flag-colour=s' => \$flag_colour, + 'flag=o' => \$flag, + 'mag-radius' => \$mag_radius, + 'radius=f' => \$radius, + 'save-temps' => \$save_temps, # Save temporary files? +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --file --ext", + -exitval => 3) + unless defined $filename + and defined $extname; + +my $status; # Status of FITSIO calls +my $fits = Astro::FITS::CFITSIO::open_file( $filename, READONLY, $status ); # FITS file handle +check_fitsio($status); +$fits->movnam_hdu(BINARY_TBL, $extname, 0, $status) and check_fitsio($status); +my $numRows; # Number of rows in table +$fits->get_num_rows($numRows, $status) and check_fitsio($status); + +my ($xCol, $yCol, $flagCol, $magCol); # Column numbers for x,y, flag, mag +$fits->get_colnum(0, 'X_PSF', $xCol, $status) and check_fitsio($status); +$fits->get_colnum(0, 'Y_PSF', $yCol, $status) and check_fitsio($status); +$fits->get_colnum(0, 'FLAGS', $flagCol, $status) and check_fitsio($status); +$fits->get_colnum(0, 'PSF_INST_MAG', $magCol, $status) and check_fitsio($status); + +my ($x, $y, $flags, $mag); # Coordinates, flags, magnitude read from table +$fits->read_col(TFLOAT, $xCol, 1, 1, $numRows, 0, $x, undef, $status) and check_fitsio($status); +$fits->read_col(TFLOAT, $yCol, 1, 1, $numRows, 0, $y, undef, $status) and check_fitsio($status); +$fits->read_col(TINT, $flagCol, 1, 1, $numRows, 0, $flags, undef, $status) and check_fitsio($status); +$fits->read_col(TFLOAT, $magCol, 1, 1, $numRows, 0, $mag, undef, $status) and check_fitsio($status); +$fits->close_file($status); + +my ($mag_min, $mag_max); # Minimum magnitude +if ($mag_radius) { + foreach my $m (@$mag) { + next unless defined $m and $m != "nan" and $m < "inf" and $m > "-inf"; + unless (defined $mag_min and defined $mag_max) { + $mag_min = $m; + $mag_max = $m; + next; + } + $mag_min = $m if $m < $mag_min; + $mag_max = $m if $m > $mag_max; + } +} + + +my ($coordFile, $coordName) = tempfile( "/tmp/ds9_cmf_regions.XXXX", UNLINK => !$save_temps ); +my $numGood = 0; # Number of good sources +my $numBad = 0; # Number of bad sources +my $radius_scale = $radius / ($mag_min - $mag_max + 1.0); # Scaling for radius +for (my $i = 0; $i < $numRows; $i++) { + my $col; # Colour to use + if ($$flags[$i] & $flag or not defined $$mag[$i] or $$mag[$i] eq "nan" or $$mag[$i] == "inf" or $$mag[$i] == "-inf") { + $numBad++; + $col = $flag_colour; + } else { + $numGood++; + $col = $colour; + } + my $r = $radius; # Radius of circle + next if $mag_radius and (not defined $$mag[$i] or $$mag[$i] eq "nan" or $$mag[$i] == "inf" or $$mag[$i] == "-inf"); + $r -= ($$mag[$i] - $mag_min) * $radius_scale if defined $mag_radius; + print $coordFile "image; circle(" . ($$x[$i] + 1) . ',' . ($$y[$i] + 1) . ",$r) \# color = $col\n"; +} +close $coordFile; + +my @settings = settings_save("regions format", + "regions system"); # Settings to save + +xpaset("frame $frame") if defined $frame; +xpaset("regions format ds9"); +xpaset("regions system image"); +xpaset("regions load $coordName"); + +xpaset(@settings); + +print "Plotted $numRows ($numGood good, $numBad bad) sources.\n"; + +### Pau. + + + + +# From Astro::FITS::CFITSIO demo +sub check_fitsio +{ + my $status = shift; # Status of FITSIO calls + + if ($status != 0) { + my $msg; # Message to output + Astro::FITS::CFITSIO::fits_get_errstatus( $status , $msg ); + croak "CFITSIO error: $msg\n"; + } +} + +# Save specified settings +sub settings_save +{ + my @settings; # Values of settings + foreach my $setting (@_) { + my @values = xpaget($setting); + push @settings, $setting . ' ' . shift @values; + } + return @settings; +} + + +# XPA subroutines courtesy Derek Fox +sub xpaset { + foreach my $cmd (@_) { + system("xpaset -p ds9 $cmd"); + } +} +sub xpaget { + my @out; + foreach my $cmd (@_) { + my $output = `xpaget ds9 $cmd`; + push @out, $output; + } + return @out; +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/fake_imfile.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/fake_imfile.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/fake_imfile.pl (revision 41105) @@ -0,0 +1,233 @@ +#!/usr/bin/env perl + +## this script is run on every imfile to perform the fake source +## analysis and the forced photometry analysis. + +## For the fake source analysis, we load the image, inject a number of +## fake source (with a flat mag distribution), save the input source, +## then perform photometry on the image to recover the input sources. +## we should save a file with the matched input and recovered +## sources. the output metadata should include an analysis of the +## recovery rate and measurement error as a function of magnitude + +## For the forced photometry, we need to use the measured astrometry +## to select the desired locations in pixel coord. + +# XXX : seeing needs to be determined from the input PSF (not currently done in ppSim) +# ppSim output -input input.fits -cmf input.cmf -psf input.psf -seeing 0.563760 -recipe PPSIM FAKEPHOT + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $faketool = can_run('faketool') or (warn "Can't find faketool" and $missing_tools = 1); +my $ppSim = can_run('ppSim') or (warn "Can't find ppSim" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ( $exp_id, $fake_id, $class_id, $chiproot, $camroot, $camera, $outroot, + $dbname, $reduction, $verbose, $no_update, $no_op, $redirect ); +GetOptions( + 'exp_id=s' => \$exp_id, # Exposure identifier + 'fake_id=s' => \$fake_id, # Chiptool identifier + 'class_id=s' => \$class_id, # Class identifier + 'chiproot=s' => \$chiproot, # Input Chip files (root) + 'camroot=s' => \$camroot, # Input Camera files (root) + 'camera|c=s' => \$camera, # Camera + 'outroot|w=s' => \$outroot, # output file base name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --exp_id --fake_id --class_id --chiproot --camroot --camera --outroot", + -exitval => 3) unless + defined $exp_id and + defined $fake_id and + defined $class_id and + defined $chiproot and + defined $camroot and + defined $camera and + defined $outroot; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +my $logDest = $ipprc->filename("LOG.IMFILE", $outroot, $class_id) or &my_die("Missing entry from camera config", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); +$ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $exp_id, $fake_id, $class_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe = $ipprc->reduction($reduction, 'FAKEPHOT'); # Recipe to use +unless ($recipe) { + &my_die("Couldn't find selected reduction for FAKE: $reduction\n", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# outroot examples (HOST components must be set) +# file://data/ipp004.0/gpc1/20080130 +# neb:///ipp004-v1/gpc1/20080130 +# neb:///*/gpc1/20080130 (volume not specified) + +# check for existing directory, generate if needed +$ipprc->outroot_prepare($outroot); + +## these names are used in ppImage, and thus may be URIs +my $chipImage = $ipprc->filename("PPIMAGE.CHIP", $chiproot, $class_id) or &my_die("Missing entry from camera config", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); +my $chipMask = $ipprc->filename("PPIMAGE.CHIP.MASK", $chiproot, $class_id) or &my_die("Missing entry from camera config", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); +my $chipWeight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $chiproot, $class_id) or &my_die("Missing entry from camera config", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); +my $chipPSF = $ipprc->filename("PSPHOT.PSF.SAVE", $chiproot, $class_id) or &my_die("Missing entry from camera config", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); +my $cameraObjects = $ipprc->filename("PSASTRO.OUTPUT", $camroot) or &my_die("Missing entry from camera config", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); +my $traceDest = $ipprc->filename("TRACE.IMFILE", $outroot, $class_id) or &my_die("Missing entry from camera config", $exp_id, $fake_id, $class_id, $PS_EXIT_CONFIG_ERROR); + +# XXX check for existence of input data +# &my_die("Couldn't find input file: $uri\n", $exp_id, $fake_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($uri); + +## get the PPSIM recipe for this camera and FAKEPHOT reduction +my $command = "$ppConfigDump -camera $camera -dump-recipe PPSIM -recipe PPSIM $recipe -"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $exp_id, $fake_id, $class_id, $PS_EXIT_SYS_ERROR); +} +my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $exp_id, $fake_id, $class_id, $PS_EXIT_SYS_ERROR); + +## allow the output images to be optional, depending on the recipe / reduction class +my $skipFake = metadataLookupBool($recipeData, 'SKIP.FAKE'); + +# Run ppSim +unless ($no_op || $skipFake) { + # examine the PPSIM recipe to decide if we need to run this or opt out + + my $command = "$ppSim $outroot"; + $command .= " -input $chipImage"; + # XXX add input mask and weight to ppSim + # $command .= " -mask $chipMask"; + # $command .= " -weight $chipWeight"; + $command .= " -cmf $cameraObjects"; + $command .= " -psf $chipPSF"; + $command .= " -recipe PPSIM $recipe"; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " -tracedest $traceDest"; + $command .= " -log $logDest"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppSim: $error_code", $exp_id, $fake_id, $class_id, $error_code); + } + + # XXX check for output files? + # &my_die("Couldn't find expected output file: $outputBin1\n", $exp_id, $fake_id, $class_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputBin1); + + # XXX use this to parse the output metadata : eg, detection limits, Nfakes, Nforced + # Get the statistics on the processed image + # my $statsFile; # File handle + # open $statsFile, $ipprc->file_resolve($outputStats) or &my_die("Can't open statistics file $outputStats: $!", $exp_id, $fake_id, $class_id, $PS_EXIT_SYS_ERROR); + # my @contents = <$statsFile>; # Contents of file + # close $statsFile; + # + # # parse the statistics MDC file + # my $mdcParser = PS::IPP::Metadata::Config->new(); # Parser for metadata config files + # my $metadata = $mdcParser->parse(join "", @contents); + # unless ($metadata) { + # &my_die("Unable to parse metadata config doc", $exp_id, $fake_id, $class_id, $PS_EXIT_PROG_ERROR); + # } + # + # # extract the stats from the metadata + # unless ($stats->parse($metadata)) { + # &my_die("Failure extracting metadata from the statistics output file.\n", $exp_id, $fake_id, $class_id, $PS_EXIT_PROG_ERROR); + # } +} else { + print "skipping ppSim processing\n"; +} + +# command to update database +$command = "$faketool -addprocessedimfile"; +$command .= " -fake_id $fake_id"; +$command .= " -exp_id $exp_id"; +$command .= " -class_id $class_id"; +$command .= " -path_base $outroot"; +$command .= " -dbname $dbname" if defined $dbname; +$command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); +# XXX add this after defined +# $command .= $stats->cmdflags(); + +# Add the processed file to the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform faketool -addprocessedimfile: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $exp_id = shift; # rawExp identifier + my $fake_id = shift; # fakeRun identifier + my $class_id = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $exp_id and defined $fake_id and defined $class_id and not $no_update) { + my $command = "$faketool -addprocessedimfile"; + $command .= " -fake_id $fake_id"; + $command .= " -exp_id $exp_id"; + $command .= " -class_id $class_id"; + $command .= " -path_base $outroot"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/flatcorr_init.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/flatcorr_init.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/flatcorr_init.pl (revision 41105) @@ -0,0 +1,212 @@ +#!/usr/bin/env perl + +## USAGE:flatcorr_init.pl +## given dbname, dvodb, filter, time range, camera, telescope, etc? +## select matching images and register as a new flatcorr run + +## should this be implemented as a ippTool program? +## this is a lot like dettool -definebyquery +## flatcorr -definebyquery +## this should queue the selected images with a mode that stops at camera +## ?? how do we block this batch from running through warp ?? + +## we also need the test / query tool: +## flatcorr -pendingcorr +## examine the chip & camera stages and check for all images to have completed (successfully or not) + +## allow a certain fraction of failures... + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Storable qw(freeze thaw); +use File::Basename qw( basename); +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration +use File::Spec; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($dvo_id, $catdir, $region, $dbname, $workdir, $no_update, $no_op); +GetOptions( + 'dvo_id|i=s' => \$dvo_id, + 'catdir|c=s' => \$catdir, + 'region|r=s' => \$region, + 'dbname|d=s' => \$dbname,# Database name + 'workdir|w=s' => \$workdir, # Working directory for output files + 'no-update' => \$no_update, + 'no-op' => \$no_op, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dvo_id --catdir --region", + -exitval => 3) unless + defined $dvo_id and + defined $catdir and + defined $region; + +# Look for programs we need +my $missing_tools; +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); +my $relphot = can_run('relphot') or (warn "Can't find relphot" and $missing_tools = 1); +my $uniphot = can_run('uniphot') or (warn "Can't find uniphot" and $missing_tools = 1); +my $relastro = can_run('relastro') or (warn "Can't find relastro" and $missing_tools = 1); +my $caltool = can_run('caltool') or (warn "Can't find caltool" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + +# select the primary filters from DVO query? +my (@filters) = `photcodeList -average`; + +# parse the region (RAs,RAe:DECs,DECe) : item = +/-NNN.NNNN +my @coords = split (":", $region); +my ($RAs, $RAe) = split (",", $coords[0]); +my ($DECs, $DECe) = split (",", $coords[1]); + +# Run addstar -resort +{ + my $command = "$addstar -resort"; + $command .= "-D CATDIR $catdir"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RESORT", $status, $dbname); + } +} + +# Run relphot (filter) for each filter +{ + foreach my $filter (@filters) { + my $command = "$relphot $filter"; + $command .= "-D CATDIR $catdir"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELPHOT", $status, $dbname); + } + } +} + +# Run uniphot (filter) for each filter +# XXX skip this one? run less frequently? +if (0) { + foreach my $filter (@filters) { + my $command = "$uniphot $filter"; + $command .= "-D CATDIR $catdir"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "UNIPHOT", $status, $dbname); + } + } +} + +{ + my $command = "$relastro -objects"; + $command .= "-D CATDIR $catdir"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELASTRO.OBJECTS", $status, $dbname); + } +} + +{ + my $command = "$relastro -images"; + $command .= "-D CATDIR $catdir"; + $command .= "-region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => 1); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort on region $region: $error_code", $dvo_id, $region, "RELASTRO.IMAGES", $status, $dbname); + } +} + +my $command = "$caltool -addcalrun"; +$command .= " -dvo_id $dvo_id"; +$command .= " -region $region"; +$command .= " -last_step RELASTRO.IMAGES"; +$command .= " -status SUCCESS"; +$command .= " -dbname $dbname" if defined $dbname; + +# Push the results into the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 1); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform regtool -addprocessedimfile: $error_code"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $dvo_id = shift; + my $region = shift; + my $last_step = shift; + my $status = shift; + my $dbname = shift; + + carp($msg); + if (defined $dvo_id && defined $region && defined $last_step && defined $status and not $no_update) { + my $command = "$caltool -addcalrun"; + $command .= " -dvo_id $dvo_id"; + $command .= " -region $region"; + $command .= " -last_step $last_step"; + $command .= " -status $status"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Pau. + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/flatcorr_proc.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/flatcorr_proc.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/flatcorr_proc.pl (revision 41105) @@ -0,0 +1,365 @@ +#!/usr/bin/env perl + +## USAGE:flatcorr_proc.pl --dbname --corr_id + +## this script does the following steps: + +# extract the details of the flatcorr run: dvodb, filter, camera, etc? + +# relphot -D CATDIR $dvodb -grid (outgrid.fits) (filter) -region 0 360 -90 90 (other parameters?) + +# dvoMakeCorr -file outgrid.fits -ref ref.fits outcorr + +# dettool -register -det_type FLATCORR -filelevel (level) -workdir -inst, etc + +# foreach $imfile () +# dettool -register_imfile -uri, etc, etc + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Storable qw(freeze thaw); +use File::Basename qw( basename); +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration +use File::Spec; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($corr_id, $det_type, $dvodb, $camera, $region, $filter, $dbname, $workdir, $make_correction, $verbose, $no_update, $no_op); +GetOptions( + 'corr_id|i=s' => \$corr_id, + 'det_type|d=s' => \$det_type, + 'dvodb|c=s' => \$dvodb, + 'camera=s' => \$camera, + 'region|r=s' => \$region, + 'filter|f=s' => \$filter, + 'dbname|d=s' => \$dbname,# Database name + 'workdir|w=s' => \$workdir, # Working directory for output files + 'make_correction' => \$make_correction, # Generate the correction image and save to the detrend database + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --corr_id --dvodb --camera --region --filter --workdir", + -exitval => 3) unless + defined $corr_id and + defined $dvodb and + defined $det_type and + defined $camera and + defined $region and + defined $workdir and + defined $filter; + +# Look for programs we need +my $missing_tools; +my $relphot = can_run('relphot') or (warn "Can't find relphot" and $missing_tools = 1); +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); +my $dvoMakeCorr = can_run('dvoMakeCorr') or (warn "Can't find dvoMakeCorr" and $missing_tools = 1); +my $detselect = can_run('detselect') or (warn "Can't find detselect" and $missing_tools = 1); +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $flatcorr = can_run('flatcorr') or (warn "Can't find flatcorr" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + +$ipprc->define_camera($camera); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# dvodb must be non-nebulous; workdir may be in nebulous +my $outgrid = "$dvodb/flatcorr/$camera.$filter.$corr_id"; +my $outcorr = "$workdir/$camera.$filter.$corr_id"; + +# check for existing directory, generate if needed +print "preparing $outcorr"; +$ipprc->outroot_prepare($outcorr); + +if (not -e "$dvodb/flatcorr") { + mkdir "$dvodb/flatcorr" or &my_die ("Unable to make output directory for relphot $dvodb/flatcorr", $corr_id, 3); +} + +# parse the region (RAs,RAe:DECs,DECe) : item = +/-NNN.NNNN +my @coords = split (":", $region); +my ($RAs, $RAe) = split (",", $coords[0]); +my ($DECs, $DECe) = split (",", $coords[1]); + +# Run addstar -resort to ensure the db is indexed +# XXX addstar should be able to recognize and skip indexed tables +{ + my $command = "$addstar -resort"; + $command .= " -D CATDIR $dvodb"; + $command .= " -region $RAs $RAe $DECs $DECe"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform addstar -resort for dvodb $dvodb on region $region: $error_code", $corr_id, $error_code); + } +} + +# Run relphot (filter) for the specified region (need to clarify the options like imfreeze) +# need to convert the camera name to the dvo camera value +{ + my $camdir = $ipprc->dvo_cameradir(); # Camera directory for addstar + + my $command = "$relphot $filter"; + $command .= " -D CAMERA $camdir"; + $command .= " -D CATDIR $dvodb"; + $command .= " -region $RAs $RAe $DECs $DECe"; + $command .= " -outroot $outgrid"; + $command .= " -imfreeze -reset -grid -mosaic"; + # XXX the -mosaic option should be recipe-selected (only valid for multichip cameras) + # XXX update the catdir after the analysis is done? + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform relphot -grid for dvodb $dvodb on region $region: $error_code", $corr_id, $error_code); + } +} + +if ($make_correction) { + + # get a single input exposure + # flatcorr -inputexp -corr_id $corr_id -limit 1 + my $chip_id = &get_chip_id(); + + # get the list of imfiles for the single input exposure + # flatcorr -inputimfile -chip_id $chip_id + my $files = &get_imfiles($chip_id); + + # set up the detrend run to store the corrected imfiles + my $det_id = &get_det_id($$files[0]); + + # make the (full-sized) detrend correction images + &make_detrend_imfiles($det_id, $files); + + # set the detrun state to 'stop' + my $command = "$dettool -updatedetrun"; + $command .= " -det_id $det_id"; + $command .= " -state stop"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform dettool -updatedetrun: $error_code"); + exit($error_code); + } +} + +# Push the results into the database +{ + my $command = "$flatcorr -addprocess"; + $command .= " -corr_id $corr_id"; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform regtool -addprocessedimfile: $error_code"); + exit($error_code); + } + } else { + print "skipping command: $command\n"; + } +} + +# get a single input exposure +# flatcorr -inputexp -corr_id $corr_id -limit 1 +sub get_chip_id { + + my $command = "$flatcorr -inputexp"; + $command .= " -corr_id $corr_id"; + $command .= " -limit 1"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool: $error_code", $corr_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $corr_id, $PS_EXIT_PROG_ERROR); + + # extract the metadata for the files into a hash list + my $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $corr_id, $PS_EXIT_PROG_ERROR); + + # check for existence + my $file = $$files[0]; + my $chip_id = $file->{chip_id}; + + return $chip_id; +} + +# get the list of imfiles for the single input exposure +# flatcorr -inputimfile -chip_id $chip_id +sub get_imfiles { + my $chip_id = shift; + + my $command = "$flatcorr -inputimfile"; + $command .= " -chip_id $chip_id"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool: $error_code", $corr_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $corr_id, $PS_EXIT_PROG_ERROR); + + # extract the metadata for the files into a hash list + my $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $corr_id, $PS_EXIT_PROG_ERROR); + + return $files; +} + +# set up the detrend run to store the corrected imfiles +sub get_det_id { + # get the filelevel from the supplied chip + my $file = shift; + + my $filelevel = $file->{filelevel}; + my $telescope = $file->{telescope}; + + my $command = "$dettool -register_detrend"; + $command .= " -det_type $det_type"; + $command .= " -filelevel $filelevel"; + $command .= " -workdir $workdir"; + $command .= " -inst $camera"; + $command .= " -telescope $telescope"; + $command .= " -filter $filter"; + $command .= " -dbname $dbname" if defined $dbname; + + ## the flat-field correction is valid for any airmass, exptime, solangle + ## for now, we assume the posangle and ccd_temp are not important + ## XXX someone needs to set the use_begin, use_end values?? + ## XXX inherit a label from the flatcorrRun? + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to register new detrend: $error_code", $corr_id, $PS_EXIT_PROG_ERROR); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $corr_id, $PS_EXIT_PROG_ERROR); + + # extract the metadata for the files into a hash list + my $output = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $corr_id, $PS_EXIT_PROG_ERROR); + + # $file = $$output[0]; + my $det_id = $$output[0]->{det_id}; + return $det_id; +} + +# use input chip images as reference images to make the detrend correction images +sub make_detrend_imfiles { + my $det_id = shift; + my $files = shift; + + foreach my $file (@$files) { + # create the detrend correction for the imfiles based on the input imfiles + my $reffile = $file->{uri}; + my $class_id = $file->{class_id}; + + my $uri = $ipprc->filename("DVOCORR.OUTPUT", $outcorr, $class_id); + unless ($uri) { + &my_die ("Unable to find DVOCORR.OUTPUT in filerules", $corr_id, $PS_EXIT_PROG_ERROR); + } + + my $command = "$dvoMakeCorr $outcorr"; + $command .= " -file $outgrid.fits"; + $command .= " -ref $reffile"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to perform dvoMakeCorr: $error_code", $corr_id, $PS_EXIT_PROG_ERROR); + } + + # register the detrend correction imfile + $command = "$dettool -register_detrend_imfile"; + $command .= " -det_id $det_id"; + $command .= " -class_id $class_id"; + $command .= " -uri $uri"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die ("Unable to register new detrend: $error_code", $corr_id, $PS_EXIT_PROG_ERROR); + } + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $corr_id = shift; + my $exit_code = shift; + + carp($msg); + if (not $no_update) { + my $command = "$flatcorr -addprocess"; + $command .= " -corr_id $corr_id"; + $command .= " -fault $exit_code"; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Pau. + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/gpc_seeing.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/gpc_seeing.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/gpc_seeing.pl (revision 41105) @@ -0,0 +1,28 @@ +#!/usr/bin/env perl +# basic ISP transmission analysis: + +if (@ARGV != 1) { die "USAGE: gpc_seeing.pl (input.fits)\n"; } +$input = $ARGV[0]; + +# for input file /path/foo.fits, use /path/foo for output + +@words = split ('\.', $input); +if (@words > 1) { pop @words; } +$output = join (".", @words); + +# use constant RECIPE => 'PPIMAGE_OBDSFRA'; # Recipe to use +$RECIPE_PPIMAGE = 'PPIMAGE_OP'; +$RECIPE_PSPHOT = 'PSPHOT.SEEING'; + +# recommend only processing to PSFMODEL +vsystem ("ppImage -file $input $output -recipe PPIMAGE $RECIPE_PPIMAGE -recipe PSPHOT $RECIPE_PSPHOT"); +if ($status) { die "failure running ppImage\n"; } + +# XXX otis can read the output psf model, or we can supply a program to interpret the model + +sub vsystem { + print STDERR "@_\n"; + my $status = system ("@_"); + $status; +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool.pl (revision 41105) @@ -0,0 +1,265 @@ +#!/usr/bin/env perl +# this program is used to run 'burntool' on images for a single chip +# for all exposures for a given time period. +# USAGE: ipp_apply_burntool.pl --dbname gpc1 --class_id XY00 --dateobs_begin YYYY/MM/DD --dateobs_end YYYY/MM/DD + +# XXX todo: +# - add filters to processedimfile +# + +use warnings; +use strict; +use Carp; + +use IPC::Cmd 0.36 qw( can_run run ); +#use IPC::Run 0.36 qw( run ); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ( $class_id, $dateobs_begin, $dateobs_end, $convert, $camera, $dbname, $logfile, $verbose, $save_temps, $rerun); +GetOptions( + 'class_id=s' => \$class_id, # chip identifier + 'dateobs_begin=s' => \$dateobs_begin, # exposure date/time range start + 'dateobs_end=s' => \$dateobs_end, # exposure date/time range stop + 'camera=s' => \$camera, # Camera + 'dbname|d=s' => \$dbname, # Database name + 'logfile=s' => \$logfile, + 'rerun' => \$rerun, + 'verbose' => \$verbose, # Print to stdout + 'save-temps' => \$save_temps, # Save temporary files? + + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --class_id --dateobs_begin --dateobs_end --dbname", + -exitval => 3, + ) unless + defined $class_id and + defined $dateobs_begin and + defined $dateobs_end and + defined $dbname; + +unless (defined $camera) { + $camera = "GPC1"; +# warn("No camera defined. Defaulting to $camera and warning."); +} + +my $missing_tools; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $funpack = can_run('funpack') or (warn "Can't find funpack" and $missing_tools = 1); +my $burntool = can_run('burntool') or (warn "Can't find burntool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $nebXattr = can_run('neb-xattr') or (warn "Can't find neb-xattr" and $missing_tools = 1); +my $nebreplicate = can_run('neb-replicate') or (warn "Can't find neb-replicate" and $missing_tools = 1); +#my $fpack = can_run('fpack') or (warn "Can't find fpack" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# IPP configuration (including nebulous) +my $ipprc = PS::IPP::Config->new( $camera ) or my_die("Unable to set up"); + +$ipprc->redirect_output($logfile) if $logfile; + +# Determine the value of a "good" burntool run. +my $config_cmd = "$ppConfigDump -camera $camera -get-key BURNTOOL.STATE.GOOD"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $config_cmd, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", 0, 0, $class_id, $PS_EXIT_SYS_ERROR); +} + +my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", 0, 0, $class_id, $PS_EXIT_SYS_ERROR); + +my $burntoolStateGood = 999; +foreach my $cfg (@$recipeData) { + if ($cfg->{name} eq 'BURNTOOL.STATE.GOOD') { + $burntoolStateGood = $cfg->{value}; + } +} +if ($burntoolStateGood == 999) { + &my_die("Failed to determine BURNTOOL.STATE.GOOD", $burntoolStateGood, $class_id, 0, $PS_EXIT_SYS_ERROR); +} +my $outState = -1 * abs($burntoolStateGood); + +print ">>$burntoolStateGood<<\n"; + +# Define list of images to examine. +my $command = "$regtool -processedimfile"; +$command .= " -class_id $class_id"; +$command .= " -dateobs_begin $dateobs_begin"; +$command .= " -dateobs_end $dateobs_end"; +$command .= " -ordered_by_date"; +$command .= " -dbname $dbname" if defined $dbname; + +( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform regtool: $error_code", $class_id, $dateobs_begin, $dateobs_end, $PS_EXIT_SYS_ERROR); +} + +my @whole = split /\n/, (join "", @$stdout_buf); +my @single = (); +my $files; +while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ); + &my_die("Unable to parse output from regtool", $class_id, $dateobs_begin, $dateobs_end, $PS_EXIT_PROG_ERROR) unless + defined $list; + push @{ $files }, @$list; + @single = (); + } +} + +#my $metadata = $mdcParser->parse(join "", @$stdout_buf) or +# &my_die("Unable to parse metadata", $class_id, $dateobs_begin, $dateobs_end, $PS_EXIT_SYS_ERROR); +# +#my $files = parse_md_list($metadata) or +# &my_die("Unable to parse metadata list", $class_id, $dateobs_begin, $dateobs_end, $PS_EXIT_SYS_ERROR); + +my $REALRUN = 1; + +# Process each file in turn, checking to see if it needs processing, and doing it all in a single pass +my $processNext = 0; +my $previousTable = ''; + +foreach my $file (@$files) { + my $exp_id = $file->{exp_id}; + my $state = $file->{burntool_state}; + + my $rawImfile = $file->{uri}; + my $rawImfileReal = $ipprc->file_resolve($rawImfile, 0); + + my $outTable = $file->{uri}; + $outTable =~ s/fits$/burn.tbl/; + my $outTableReal = $ipprc->file_resolve($outTable, 1); + + my $process = 0; + my $previousTableStyle = 0; + + if ($state == 0) { + $process = 1; + } + elsif ($state == -1) { + $process = 1; + } + elsif ($state == -3) { + $process = 1; + } + elsif ($state == -2) { + &my_die("Aborting as $rawImfile has modified pixel data!"); + } + elsif ($state == $burntoolStateGood) { + $process = 0; + $previousTableStyle = 1; + } + elsif ($state == -1 * $burntoolStateGood) { + $process = 0; +# $previousTable = "in=$outTableReal"; + $previousTableStyle = -1; + } + else { + $process = 1; + } + if ($rerun) { + $process = 1; + } + if ($REALRUN == 0) { + print "##Pretending to process as instructed!\n"; + $process = 1; + } + if (($process == 1)||($processNext == 1)) { + $processNext = 1; + # Set state to processing + my $status = vsystem ("$regtool -dbname $dbname -updateprocessedimfile -exp_id $exp_id -class_id $class_id -burntool_state -1", $REALRUN); + if ($status) { + &my_die("failed to update imfile"); + } + $file->{burntool_state} = -1; + + my $tempfile = new File::Temp ( TEMPLATE => "$file->{exp_name}.XXXX", + DIR => '/tmp/', + UNLINK => !$save_temps, + SUFFIX => '.fits'); + my $tempPixels = $tempfile->filename; + + # Run burntool + $status = vsystem ("$funpack -S $rawImfileReal > $tempPixels", $REALRUN); + if ($status) { + &my_die("failed on funpack",$exp_id,$class_id); + } + if ($previousTable ne '') { + $status = vsystem ("$burntool $tempPixels $previousTable out=$outTableReal tableonly=t persist=t", $REALRUN); + } + else { + $status = vsystem ("$burntool $tempPixels out=$outTableReal tableonly=t persist=t", $REALRUN); + } + if ($status) { + &my_die("failed on burntool",$exp_id,$class_id); + } + &my_die("Unable to find output file: $outTableReal", $exp_id, $class_id) unless $ipprc->file_exists($outTableReal); + + $status = vsystem ("$nebXattr --write $outTable user.copies:2",$REALRUN); + $status = vsystem ("$nebreplicate --set_copies 2 $outTable",$REALRUN); + $status = vsystem ("$regtool -dbname $dbname -updateprocessedimfile -exp_id $exp_id -class_id $class_id -burntool_state $outState", $REALRUN); + if ($status) { + &my_die("failed to update imfile"); + } + + $previousTableStyle = -1; + + print "\n"; + } + + if ($previousTableStyle == 1) { + $previousTable = "infits=$rawImfileReal"; + } + elsif ($previousTableStyle == -1) { + $previousTable = "in=$outTableReal"; + } + else { + die "previousTableStyle undefined!\n"; + } + +} + +exit 0; + +sub vsystem { + my $command = shift; + my $realrun = shift; + + print "$command\n"; + + my $status = 0; + if ($realrun) { + $status = system ($command); + } + + return $status; +} + +sub my_die { + my $message = shift; + if ($#_ != -1) { + my $exp_id = shift; + my $class_id = shift; + vsystem("$regtool -dbname $dbname -updateprocessedimfile -exp_id $exp_id -class_id $class_id -burntool_state -3",1); + } + printf STDERR "$message\n"; + exit 1; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool_fix.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool_fix.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool_fix.pl (revision 41105) @@ -0,0 +1,142 @@ +#! /usr/bin/env perl + +use strict; +use warnings; + +use Carp; +use IPC::Cmd 0.36 qw( can_run run ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + + +my $missing_tools; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $burntool = can_run('ipp_apply_burntool_single.pl') or (warn "Can't find ipp_burntool_apply_single.pl" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my $save; +my $exp_name; +my $class_id; +my $dbname = 'gpc1'; +my $camera = 'GPC1'; +my $verbose = 0; +GetOptions( + 'save=s' => \$save, + 'exp_name|e=s' => \$exp_name, + 'class_id|c=s' => \$class_id, + 'verbose|v' => \$verbose, + 'dbname=s' => \$dbname, +) or pod2usage( 2 ); + +die "usage: $0 --exp_name (exp_name) --class_id (class_id)\n" unless $class_id and $exp_name; + +# Set up the commands we'll use: +$regtool .= " -dbname $dbname -exp_name $exp_name -class_id $class_id"; +$burntool .= " --dbname $dbname --camera $camera"; + +# Check database entry for this to get the exp_id and image uri +my $regData; +{ + my $command = "$regtool -processedimfile"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + carp("Unable to perform $command: $error_code"); + exit $error_code; + } + my $list = $mdcParser->parse(join "", @$stdout_buf) or die("Unable to parse regtool metadata"); + my $mdc = parse_md_list($list); + $regData = $mdc->[0]; +} + +my $exp_id = $regData->{exp_id}; +my $uri = $regData->{uri}; + +die "failed to find exp_name in regtool output" unless $exp_name; +die "failed to find uri in regtool output" unless $uri; + +# Construct burntool table name +my $table; +($table = $uri) =~ s/\.fits/\.burn\.tbl/; +print "$table\n"; + +# Look for the old table, and if it exists, move it out of the way and delete it so we can work from scratch. +my $table_exists; +{ + my $command = "neb-stat $table"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + if ($success) { + $table_exists = 1; + } else { + $table_exists = 0; + } +} + +if ($table_exists) { + # file exists + my $moved = "$table.bad"; + my $command = "neb-mv $table $moved"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + carp("Unable to perform $command: $error_code"); + exit $error_code; + } + # don't care if this fails + &vsystem ("neb-rm --force $moved"); +} + +# Calculate the previous uri for the table by decrementing the nightly image sequence +my $left = substr $exp_name, 0, 6; +my $num = substr $exp_name, 6, 4; +my $end = substr $exp_name, 10, 1; + +# print "$left $num $end\n"; + +my $prev = $num - 1; +my $prev_name = sprintf "$left%04d$end", $prev; + +my $prev_uri = $uri; +$prev_uri =~ s/$exp_name/$prev_name/g; +die "failed" unless $prev_uri; + +# Run the burntool command to generate the table. +{ + my $command = "$burntool --exp_id $exp_id --class_id $class_id --this_uri $uri --previous_uri $prev_uri"; + $command .= " --verbose" if $verbose; + print "$command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 1); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + carp("Unable to perform $command: $error_code"); + exit $error_code; + } +} + +# This isn't needed, but doesn't hurt anything. +# Copy the table we just made to a local directory +if (defined $save) { + my $nebfile = `neb-locate -p $table`; chomp $nebfile; + vsystem ("cp $nebfile $save"); +} + + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + my $status = system ("@_"); + $status; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool_single.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool_single.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_apply_burntool_single.pl (revision 41105) @@ -0,0 +1,433 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +use IPC::Cmd 0.36 qw( can_run run ); +#use IPC::Run 0.36 qw( run ); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my $REALRUN = 1; + +my ( $class_id, $exp_id, $this_uri, $previous_uri, $imfile_state, $camera, $dbname, $logfile, $verbose, $save_temps ); +my ( $rerun, $fixit ); +my $continue = 0; +GetOptions( + 'exp_id=s' => \$exp_id, # exposure identifier + 'class_id=s' => \$class_id, # chip identifier + 'this_uri=s' => \$this_uri, # uri for this image + 'previous_uri=s' => \$previous_uri, # uri for the previous image + 'imfile_state=s' => \$imfile_state, # current state of the imfile. + 'camera=s' => \$camera, # Camera + 'dbname|d=s' => \$dbname, # Database name + 'logfile=s' => \$logfile, + 'rerun' => \$rerun, +# 'fix|f' => \$fixit, + 'continue=i' => \$continue, + 'verbose' => \$verbose, # Print to stdout + 'save-temps' => \$save_temps, # Save temporary files? + + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --class_id --this_uri --exp_id --dbname", + -exitval => 3, + ) unless + defined $class_id and + defined $this_uri and + defined $exp_id and + defined $dbname; + +# XXX watch out for TC3 and GPC2 here: +unless (defined $camera) { + if ($this_uri =~ /ota/) { + $camera = "GPC1"; + } + } + +my $missing_tools; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $funpack = can_run('funpack') or (warn "Can't find funpack" and $missing_tools = 1); +my $burntool = can_run('burntool') or (warn "Can't find burntool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $nebXattr = can_run('neb-xattr') or (warn "Can't find neb-xattr" and $missing_tools = 1); +my $nebreplicate = can_run('neb-replicate') or (warn "Can't find neb-replicate" and $missing_tools = 1); +#my $fpack = can_run('fpack') or (warn "Can't find fpack" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# IPP configuration (including nebulous) +my $ipprc = PS::IPP::Config->new( $camera ) or my_die("Unable to set up"); + +unless (defined $logfile) { + $logfile = $this_uri; + $logfile =~ s/fits/burn.log/; +} +$ipprc->redirect_output($logfile) if $logfile; + +# Determine the value of a "good" burntool run. +my $config_cmd = "$ppConfigDump -camera $camera -get-key BURNTOOL.STATE.GOOD"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $config_cmd, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $exp_id, $class_id, $PS_EXIT_SYS_ERROR); +} + +my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $exp_id, $class_id, $PS_EXIT_SYS_ERROR); + +my $burntoolStateGood = 999; +foreach my $cfg (@$recipeData) { + if ($cfg->{name} eq 'BURNTOOL.STATE.GOOD') { + $burntoolStateGood = $cfg->{value}; + } +} +if ($burntoolStateGood == 999) { + &my_die("Failed to determine BURNTOOL.STATE.GOOD", $exp_id, $class_id, $PS_EXIT_SYS_ERROR); +} +my $outState = -1 * abs($burntoolStateGood); + +print ">>$burntoolStateGood<<\n"; + +# Determine what to do if we're fixing. +# if ($fixit) { +# ($exp_id,$this_uri,$previous_uri,$continue) = fix_burntool($exp_id,$this_uri,$class_id); +# } + + +# Precalculate what we should be able to do if we're continuing +my @continue_uris; +my @continue_exp_ids; +my @continue_states; +if ($continue > 0) { + my $regtool_get_date = "$regtool -processedimfile -exp_id $exp_id -class_id $class_id -dbname $dbname"; + my $dateobs; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $regtool_get_date, verbose => $verbose ); + unless ($success) { + $continue = 0; + last; + } + my $imfile_data = $mdcParser->parse(join "", @$stdout_buf); + my $imfile_data2 = parse_md_list($imfile_data); + if ($#{ $imfile_data2 } > 0) { + &my_die("Too many entries returned for date query", $exp_id, $class_id, $PS_EXIT_SYS_ERROR); + } + foreach my $entry (@$imfile_data2) { + $dateobs = $entry->{dateobs}; + } + my $date = $dateobs; $date =~ s/T.*//; + + my $regtool_status_cmd = "$regtool -checkstatus -dateobs_begin $dateobs -dateobs_end ${date}T17:30:00 -class_id $class_id -dbname $dbname"; + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $regtool_status_cmd, verbose => $verbose ); + unless ($success) { + print "Unsuccessful at running regtool -checkstatus, aborting continue\n"; + $continue = 0; + } + if ($continue != 0) { + my $night_data = $mdcParser->parse(join "", @$stdout_buf); + my $night_data2 = parse_md_list($night_data); + my $addable = 0; + + foreach my $entry (@$night_data2) { + my ($this_exp_id,$this_uri,$this_state); + if ($entry->{exp_id} == $exp_id) { + $addable = 1; + next; + } + if (($addable == 1)&&($#continue_exp_ids < $continue)) { + $this_exp_id = $entry->{exp_id} ? $entry->{exp_id} : 0; + $this_uri = $entry->{uri} ? $entry->{uri} : 'NULL'; + $this_state = $entry->{imfile_state} ? $entry->{imfile_state} : 'NULL'; + print ">> $this_exp_id $this_uri $this_state\n"; + if ($this_state eq 'pending_burntool') { + push @continue_exp_ids, $this_exp_id; + push @continue_uris, $this_uri; + push @continue_states, $this_state; + } + else { + last; + } + } + if ($#continue_exp_ids >= $continue) { + last; + } + } + } +} +$continue = $#continue_exp_ids + 1; + +# Look over at least one uri/imfile/exp_id and do burntool on it. +my $next_exp_id; +for (my $iteration = 0; $iteration <= $continue; $iteration ++) { +# Set up files + my $rawImfile = $this_uri; + my $rawImfileReal = $ipprc->file_resolve($rawImfile, 0); + + my $outTable = $this_uri; + $outTable =~ s/fits$/burn.tbl/; + my $outTableReal = $ipprc->file_resolve($outTable, 1); + if (!$outTableReal) { + &my_die("failed to resolve output file: $outTable",$exp_id,$class_id); + } + + my $previousTable; + my $previousTableReal; + if ($previous_uri) { + $previousTable = $previous_uri; + $previousTable =~ s/fits$/burn.tbl/; + $previousTableReal = $ipprc->file_resolve($previousTable, 0); + if (!$previousTableReal) { + &my_die("failed to resolve input file: $previousTable",$exp_id,$class_id); + } + } + +# Set state to processing: + my $burntool_state = 0; + + my $status = vsystem ("$regtool -dbname $dbname -updateprocessedimfile -exp_id $exp_id -class_id $class_id -burntool_state -1", $REALRUN); + if ($status) { + &my_die("failed to update imfile",$exp_id,$class_id); + } + $burntool_state = 1; + + +# funpack + my $tempfile = new File::Temp ( TEMPLATE => "burntool.${exp_id}.${class_id}.XXXX", + DIR => '/tmp/', + UNLINK => !$save_temps, + SUFFIX => '.fits'); + my $tempPixels = $tempfile->filename; + + $status = vsystem ("$funpack -S $rawImfileReal > $tempPixels", $REALRUN); + if ($status) { + &my_die("failed on funpack",$exp_id,$class_id); + } + +# burntool + if (($previousTableReal)&&($previousTableReal ne '')) { + $status = vsystem ("$burntool $tempPixels in=$previousTableReal out=$outTableReal tableonly=t persist=t", $REALRUN); + } + else { + $status = vsystem ("$burntool $tempPixels out=$outTableReal tableonly=t persist=t", $REALRUN); + } + if ($status) { + &my_die("failed on burntool",$exp_id,$class_id); + } + &my_die("Unable to find output file: $outTableReal", $exp_id, $class_id) unless $ipprc->file_exists($outTableReal); + +# Replicate files + $status = vsystem ("$nebXattr --write $outTable user.copies:2",$REALRUN); + $status = vsystem ("$nebreplicate --set_copies 2 $outTable",$REALRUN); + +# Prep for next iteration if necessary. + if ($iteration < $continue) { + $next_exp_id = shift(@continue_exp_ids); + my $command = "$regtool -dbname $dbname -updateprocessedimfile -exp_id $next_exp_id -class_id $class_id -set_state check_burntool"; + $status = vsystem ($command, $REALRUN); + if ($status) { + $continue = 0; + } + } +# Set state to finished. + my $command = "$regtool -dbname $dbname -updateprocessedimfile -exp_id $exp_id -class_id $class_id -burntool_state $outState"; + if ($imfile_state ne 'full') { + $command .= " -set_state full "; + } + + $status = vsystem ($command, $REALRUN); + if ($status) { + &my_die("failed to update imfile",$exp_id,$class_id); + } + +# Set values for the next iteration if we are doing another iteration. + $previous_uri = $this_uri; + if ($iteration < $continue) { + $this_uri = shift (@continue_uris); + $exp_id = $next_exp_id; + $imfile_state = shift(@continue_states); + } + +} +exit 0; + +sub vsystem { + my $command = shift; + my $realrun = shift; + + print "$command\n"; + + my $status = 0; + if ($realrun) { + $status = system ($command); + } + + return $status; +} + +sub my_die { + my $message = shift; + if ($#_ != -1) { + my $exp_id = shift; + my $class_id = shift; + sleep(5); # Take a quick nap to let the database cool down, in case we failed doing an update. + vsystem("$regtool -dbname $dbname -updateprocessedimfile -exp_id $exp_id -class_id $class_id -burntool_state 0 -set_state pending_burntool",1); + } + printf STDERR "$message\n"; + exit 1; +} + +# sub fix_burntool { +# my ($exp_id,$this_uri,$class_id,$burntoolGoodState) = @_; +# my ($dateobs,$exp_name); +# # Calculate the date for this exposure, and calculate back to find the burntool period. +# my $regtool_get_date = "$regtool -processedimfile -exp_id $exp_id -class_id $class_id -dbname $dbname"; +# my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run ( command => $regtool_get_date, verbose => $verbose ); +# unless ($success) { +# $continue = 0; +# return($exp_id,$this_uri,undef,0); +# } +# my $imfile_data = $mdcParser->parse(join "", @$stdout_buf); +# foreach my $entry (@$imfile_data) { +# if ($entry->{name} eq 'dateobs') { +# $dateobs = $entry->{value}; +# } +# if ($entry->{name} eq 'exp_name') { +# $exp_name = $entry->{value}; +# } +# } +# my $date = $dateobs; $date =~ s/T.*//; +# my $time = $dateobs; $time =~ s/.*T//; +# my ($hour,$min,$sec) = split /\:/, $time; #/; +# if ($min >= 30) { +# $min -= 30; +# } +# else { +# $min += 30; +# $hour -= 1; +# } +# my $dateobs_begin = sprintf("%sT%02d:%02d:%02d",$date,$hour,$min,$sec); + + +# # Get the night data for this date range. +# my $regtool_status_cmd = "$regtool -checkstatus -dateobs_begin $dateobs_begin -dateobs_end $dateobs -class_id $class_id -dbname $dbname"; +# ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run ( command => $regtool_get_date, verbose => $verbose ); +# unless ($success) { +# return($exp_id,$this_uri,undef,0); +# } + +# my $night_data = $mdcParser->parse(join "", @$stdout_buf); + +# my $mode; +# my ($row_exp_id,$row_uri,$row_data_state,$row_bt_state); +# my $entry = @$night_data[-1]; +# foreach my $row (@$entry) { # This is a single exposure, so let's get everything we'll need here. +# if ($row->{name} eq 'exp_id') { +# $row_exp_id = $row->{value}; +# } +# elsif ($row->{name} eq 'uri') { +# $row_uri = $row->{uri}; +# } +# elsif ($row->{name} eq 'data_state') { +# $row_data_state = $row->{data_state}; +# } +# elsif ($row->{name} eq 'burntool_state') { +# $row_bt_state = $row->{burntool_state}; +# } +# } +# # Determine what to do. +# if ($row_exp_id == $exp_id) { +# if (($row_bt_state != $burntoolStateGood)) { +# # Never been run. +# $mode = 1; +# } +# else { +# $mode = 0; +# } +# } +# if ($mode == 0) { +# # If we're here, then the database thinks we have a table for this uri on disk. Let's see if that's true. +# # Zero byte file/good alternate +# # Inconsistent md5sums +# # Missing this table only. +# my $neb = $ipprc->nebulous(); +# my $table_key = $this_uri; $table_key =~ s/fits/burn.tbl/; + +# my $neb_instances = $neb->find_instances($table_key, 'any'); + +# my $Ninstances = $#{ $neb_instances } + 1; + +# if (($Ninstances == 0)||($Ninstances == 1)) { +# #Missing this table only. This should fall through to do a regular pass on this uri +# $continue = 0; +# $entry = @$night_data[-2]; +# foreach my $row (@$entry) { # This is a single exposure, so let's get everything we'll need here. +# if ($row->{name} eq 'exp_id') { +# $row_exp_id = $row->{value}; +# } +# elsif ($row->{name} eq 'uri') { +# $row_uri = $row->{uri}; +# } +# elsif ($row->{name} eq 'data_state') { +# $row_data_state = $row->{data_state}; +# } +# elsif ($row->{name} eq 'burntool_state') { +# $row_bt_state = $row->{burntool_state}; +# } +# } +# $previous_uri = $row_uri; +# # Go through to regular processing of this exposure. +# } +# elsif ($Ninstances == 2) { +# $md5sum_A = md5sum(${ $neb_instances }[0]); +# $md5sum_B = md5sum(${ $neb_instances }[1]); +# if ($md5sum_A != $md5sum_B) { +# # md5sums are different +# if ($md5sum_A = 'd41d8cd98f00b204e9800998ecf8427e') { +# # copy B -> A +# } +# elsif ($md5sum_B = 'd41d8cd98f00b204e9800998ecf8427e') { +# # copy A -> B +# } +# else { +# # different but unknown why +# } +# } +# } +# } + +# if ($mode == 1) { +# foreach my $entry (reverse(@$night_data)) { # reverse it so we can start with the exposure we have and go backwards +# foreach my $row (@$entry) { # This is a single exposure, so let's get everything we'll need here. +# if ($row->{name} eq 'exp_id') { +# $row_exp_id = $row->{value}; +# } +# elsif ($row->{name} eq 'uri') { +# $row_uri = $row->{uri}; +# } +# elsif ($row->{name} eq 'data_state') { +# $row_data_state = $row->{data_state}; +# } +# elsif ($row->{name} eq 'burntool_state') { +# $row_bt_state = $row->{burntool_state}; +# } +# } +# } +# } + +# return($exp_id,$this_uri,$previous_uri,$continue); +# } Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_cleanup.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_cleanup.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_cleanup.pl (revision 41105) @@ -0,0 +1,2412 @@ +#!/usr/bin/env perl + +# this script is used to cleanup the files from the different ipp +# stages. It can be called with one of two cleanup modes: clean and +# purge. the former removes temporary data files, leaving behind +# enough information for the results to be rebuilt. The latter +# removes all but basic logging data. + +use warnings; +use strict; +use Carp; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($stage, $camera, $stage_id, $mode, $path_base, $dbname, $verbose, $no_op, $helplist, $logfile, $check_all); +my $very_verbose = 0; + +# turn this on to set data_state to error_state for components for which cleanup fails +# Note: we no longer do this, we leave the state alone. +my $set_error_state_for_file = 0; + +# turn this on the set the state to error_state when errors occur cleaning up individual components +# We may stop doing this +my $set_error_state_for_run = 0; + +# this gets set to 1 the first time we set the corresponding destreak run to be cleaned +#my $ds_done = 0; +# magic is dead +my $ds_done = 1; + +GetOptions('stage=s' => \$stage, # which analysis stage to clean? + 'camera|i=s' => \$camera, # user-supplied camera name + 'stage_id=s' => \$stage_id, # id for this stage (only needed for certain stages) + 'mode|m=s' => \$mode, # cleanup mode (clean / purge) + 'path_base=s' => \$path_base, # basename for files + 'check-all' => \$check_all, # if set clean all chips regardless of data_state + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-op' => \$no_op, # pretend but don't actually inject + 'helplist' => \$helplist, # give help listing + 'logfile=s' => \$logfile # destination for stdout and stderr + ) or pod2usage( 2 ); + +pod2usage( -msg => "remove temporary / all data files for an IPP analysis stage", + -exitval => 2) if defined $helplist; + +pod2usage( -msg => "Usage: $0 --camera (name) --stage (stage) --stage_id (stage_id) --mode (mode) [--path_base (path)] [--dbname dbname] [--no-op] [--help]", + -exitval => 2 ) if scalar @ARGV; + +pod2usage( -msg => "Required options:--camera (name) --stage (stage) --mode (mode)", + -exitval => 3) unless + defined $camera and + defined $stage and + defined $mode; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die("Unable to set up", $stage_id, $PS_EXIT_CONFIG_ERROR); # this is used for PATH, NEB filename conversions + +# $mode must be one of "goto_cleaned", "goto_scrubbed", or +# "goto_purged" goto_cleaned and goto_scrubbed both result in +# 'cleaned' on success ('scrubbed' allows chips without config files +# to be cleaned; they cannot be recovered, but the small data is left +# behind). XXX make 'scrubbed' a data_state? +unless (($mode eq "goto_cleaned") || ($mode eq "goto_scrubbed") || ($mode eq "goto_purged")) { + die "invalid cleanup mode $mode\n"; +} + +$ipprc->redirect_output($logfile) or + &my_die("Unable to redirect ouput", $stage, $stage_id, $PS_EXIT_UNKNOWN_ERROR) if $logfile; + + +my $hostname = `hostname`; +chomp $hostname; +print STDERR "starting cleanup for $stage $stage_id on $hostname\n" ; + +my $nebulous_server; + +my $bzip2 = can_run('bzip2') or die 'cannot find bzip2\n'; + +# set this to 1 to enable checking for files on dead nodes +# it is off for now because the implementation is a hack +# See comments below. +my $check_for_gone = 1; + +my $error_state; +my $done_state; +if ($mode eq "goto_cleaned") { $error_state = "error_cleaned"; $done_state = "cleaned"; } +if ($mode eq "goto_scrubbed") { $error_state = "error_scrubbed"; $done_state = "scrubbed";} +if ($mode eq "goto_purged") { $error_state = "error_purged"; $done_state = "purged";} + + +my %stages = ( "chip" => 1, "camera" => 1, "fake" => 1, "warp" => 1, "stack" => 1, "diff" => 1, + "chip_bg" => 1, "warp_bg" => 1, + "detrend.processed" => 1, "detrend.resid" => 1, "detrend.process.exp" => 0, "detrend.stack.imfile" => 0, + "detrend.normstat.imfile" => 0, "detrend.norm.imfile" => 0, "detrend.norm.exp" => 0 ); +unless (exists($stages{$stage})) { + die "unknown stage $stage for ipp_cleanup.pl\n"; +} +unless (($stages{$stage})) { + die "unimplemented stage $stage for ipp_cleanup.pl\n"; +} + + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# choice of files to delete depends on the stage +if ($stage eq "chip") { + + die "--stage_id required for stage chip\n" if !$stage_id; + ### select the imfiles for this entry + + # this stage uses 'chiptool' + my $chiptool = can_run('chiptool') or die "Can't find chiptool"; + my $censorObjects = can_run('censorObjects') or die "Can't find censorObjects"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $imfiles; # Array of component files + my $command = "$chiptool -pendingcleanupimfile -chip_id $stage_id"; # Command to run + $command .= ' -all' if ($check_all); + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) + = run(command => $command, verbose => $very_verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", "chip", $stage_id, $error_code); + } + + # if there are no chipProcessedImfiles (@$stdout_buf == 0) then assume that we're done + # it could be that there are no chipProcessedImfiles at all if say if a run was changed from drop to goto_cleaned + # or of a run was set to update and then back to goto_cleaned before any images were processed + if (@$stdout_buf == 0) { + my $command = "$chiptool -chip_id $stage_id -updaterun -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool -processedimfile: $error_code", "chip", $stage_id, $error_code); + } + exit 0; + } + + # extract the metadata for the files into a hash list + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "chip", $stage_id, $PS_EXIT_PROG_ERROR); + + my $numchips = scalar @$imfiles; + print "Found $numchips to clean\n"; + + my $clean_sources = 0; + if ((scalar @$imfiles > 0) and ($mode eq 'goto_cleaned')) { + # go and find the smf file(s) for the associated camRun and check the status of the file + # if a good one is found we have the sources for this chipRun and thus can clean the cmfs + my $command = "$chiptool -listrun -chip_id $stage_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $very_verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool -listrun: $error_code", "chip", $stage_id, $error_code); + } + my $entries = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "chip", $stage_id, $PS_EXIT_PROG_ERROR); + my $good_smf = 0; + foreach my $entry (@$entries) { + my $camRun_state = $entry->{camRun_state}; + next if $camRun_state ne 'full'; + my $cam_id = $entry->{cam_id}; + if (!$cam_id) { + carp('no cam_id for listrun entry'); + next; + } + my $cam_path_base = $entry->{cam_path_base}; + if ( !defined $cam_path_base ) { + carp("no path_base for $cam_id\n"); + next; + } + + # XXX: This assumes that the filerules are filerules-split + my $smf = $ipprc->filename("PSASTRO.OUTPUT", $cam_path_base); + if (!$ipprc->file_exists($smf)) { + carp("smf for $cam_path_base not found"); + next; + } + # we run the program censorObjects in the check mode + # If this program succeeds the smf is a valid fits file and each of the + # extensions was succesfully read. + # XXX: create a new program outside of magic that performs this check + + my $command = "$censorObjects -checkinputonly -file $smf"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $very_verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + print STDERR "censorObjects failed:\n"; + print STDERR "\nSTDOUT:\n" . join "", @$stdout_buf; + print STDERR "\nSTDERR:\n" . join "", @$stderr_buf; + # smf file is probably corrupt. Carry on. We will not clean sources unless another good smf is found + # &my_die("Unable to perform censorObjects -checkinputonly: $error_code", "chip", $stage_id, $error_code); + next; + } + $good_smf++; + } + if ($good_smf) { + # we have a good one so we can clean the sources + $clean_sources = 1; + print "Found $good_smf good smf files will clean sources\n"; + } else { + print "Unable to find good smf file will NOT clean sources\n"; + } + } + + # loop over all of the imfiles, determine the path_base and class_id for each + my $num_errors = 0; + my $num_updated = 0; + foreach my $imfile (@$imfiles) { + my $class_id = $imfile->{class_id}; + my $path_base = $imfile->{path_base}; + my $data_state = $imfile->{data_state}; + my $status = 1; + $status = 0 unless defined $path_base and $path_base ne "NULL"; + + my $quality = $imfile->{quality}; + my $good_quality = ($quality == 0); + + print "Starting cleanup for $class_id\n"; + + # don't clean up unless the data needed to update is available + # modes goto_purged and goto_scrubbed will remove files even if the config is non-existent + # goto_scrubbed now requires the config file to not exist. + if ($status and $good_quality) { + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PPIMAGE.CONFIG", $path_base, $class_id); + + unless ($ipprc->file_exists($config_file)) { + my $fault = $imfile->{fault}; + + if (file_gone($config_file) or !storage_object_exists($config_file)) { + # config file was lost. Clean up. If the chip is ever updated a new config + # file will be created + print STDERR "forcing cleanup chip $stage_id $class_id fault: $fault quality: $quality" + . " because config file ($config_file) is gone\n"; + } elsif ($fault == 0 and $quality == 0) { + print STDERR "skipping cleaning up chip $stage_id $class_id fault: $fault quality: $quality" + . " because config file ($config_file) is missing\n"; + $status = 0; + } else { + # config file is missing but this is a bad chip anyways so clean it + print STDERR "cleaning up chip $stage_id $class_id fault: $fault quality: $quality" + . " even though config file ($config_file) is missing\n"; + } + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PPIMAGE.CONFIG", $path_base, $class_id); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping scrubbed for chip $stage_id $class_id " + . " because config file ($config_file) is present\n"; + $status = 0; + } + } + } + + if ($status) { + # array of actual filenames to delete + my @files = (); + + addFilename (\@files, "PPIMAGE.CHIP", $path_base, $class_id, 1); + addFilename (\@files, "PPIMAGE.CHIP.MASK", $path_base, $class_id, 1); + addFilename (\@files, "PPIMAGE.CHIP.VARIANCE", $path_base, $class_id, 1); + addFilename (\@files, "PPIMAGE.PATTERN", $path_base, $class_id, 0); + if ($clean_sources) { + addFilename (\@files, "PSPHOT.OUTPUT", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.BIN1", $path_base, $class_id); + } + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + if (!$clean_sources) { + # these weren't added above but we do want to clean it + addFilename (\@files, "PSPHOT.OUTPUT", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.BIN1", $path_base, $class_id); + } + + # background model is needed to build stack background images so we do not remove it + # addFilename (\@files, "PSPHOT.BACKMDL", $path_base, $class_id); + + addFilename (\@files, "PSPHOT.PSF.SAVE", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.OUTPUT.FPA1", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.OUTPUT.FPA2", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.BIN2", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.JPEG1", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.JPEG2", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.STATS", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.CONFIG", $path_base, $class_id); + } + + # actual command to delete the files + $status = &delete_files (\@files); + } + bzip2_file("LOG.IMFILE", $path_base, $class_id); + bzip2_file("LOG.IMFILE.UPDATE", $path_base, $class_id); + + if ($status) { + my $update_chip = 1; + my $command = "$chiptool -chip_id $stage_id -class_id $class_id"; + if ($mode eq "goto_purged") { + $command .= " -topurgedimfile"; + if ($data_state eq 'purged') { + $update_chip = 0; + } + } + elsif ($mode eq "goto_cleaned") { + $command .= " -tocleanedimfile"; + if ($data_state eq 'cleaned') { + $update_chip = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -toscrubbedimfile"; + if ($data_state eq 'scrubbed') { + $update_chip = 0; + } + } + + if ($update_chip) { + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", "chip", $stage_id, $error_code); + } + set_destreak_goto_cleaned(); + $num_updated++; + } + } else { + $num_errors++; + + if ($set_error_state_for_file) { + # if an error happens for one chip, the chipRun will stay in goto_*, but the chips will go to error_* (matching the goto_*) + my $command = "$chiptool -updateprocessedimfile -chip_id $stage_id -class_id $class_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", "chip", $stage_id, $error_code); + } + } + + if ($set_error_state_for_run) { + # We want to flag the run as well, to avoid attempting to reprocess the same data over and over again. + $command = "$chiptool -chip_id $stage_id -updaterun -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", "chip", $stage_id, $error_code); + } + + } + } + } + # We no longer depend on chiptool to promote the run from goto_cleaned to cleaned based on all of + # the imfiles being in the cleaned state. + # Due to missing files we don't always clean individual components. + # So unless there was an error set state to $done_state + if (!$set_error_state_for_run or $num_errors eq 0) { + # set state to $done_state + my $command = "$chiptool -chip_id $stage_id -updaterun -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", "chip", $stage_id, $error_code); + } + } + print "Cleanup completed for chip_id $stage_id. num_updated: $num_updated"; + print " num_errors: $num_errors" if $num_errors; + print "\n"; + exit 0; +} + +if ($stage eq "camera") { + die "--stage_id required for stage camera\n" if !$stage_id; + # this stage uses 'camtool' + my $camtool = can_run('camtool') or die "Can't find camtool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $exps; # Array of component files + my $command = "$camtool -pendingcleanupexp -cam_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool: $error_code", "camera", $stage_id, $error_code); + } + $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "camera", $stage_id, $PS_EXIT_PROG_ERROR); + + my $n_exps = @$exps; + &my_die("unexpected number of exposures $n_exps", "camera", $stage_id, $PS_EXIT_PROG_ERROR) + if $n_exps != 1; + + my $exp = $exps->[0]; + my $path_base = $exp->{path_base}; + + my $status = 1; + # don't clean up unless the data needed to update is available + # goto_scrubbed now requires the config file to not be present + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PSASTRO.CONFIG", $path_base); + + unless ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for camRun $stage_id because config file is missing\n"; + $status = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PSASTRO.CONFIG", $path_base); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for camRun $stage_id because config file ($config_file) is present\n"; + $status = 0; + } + } + if ($status) { + my @files = (); + # delete the temporary image datafiles +# addFilename (\@files, "PSASTRO.OUTPUT", $path_base); + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PPIMAGE.JPEG1", $path_base); + addFilename (\@files, "PPIMAGE.JPEG2", $path_base); + addFilename (\@files, "PSASTRO.STATS", $path_base); + } + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + my $command; + if ($mode eq "goto_cleaned") { + $command = "$camtool -updaterun -cam_id $stage_id -set_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command = "$camtool -updaterun -cam_id $stage_id -set_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command = "$camtool -updaterun -cam_id $stage_id -set_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool: $error_code", "camera", $stage_id, $error_code); + } + + set_destreak_goto_cleaned(); + + } else { + # since 'camera' has only a single imfile, we can just update the run + my $command = "$camtool -updaterun -cam_id $stage_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool: $error_code", "camera", $stage_id, $error_code); + } + exit $PS_EXIT_UNKNOWN_ERROR; + } + + + exit 0; +} + +if ($stage eq "warp") { + die "--stage_id required for stage warp\n" if !$stage_id; + # this stage uses 'warptool' + my $warptool = can_run('warptool') or die "Can't find warptool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $skyfiles; # Array of component files + my $command = "$warptool -pendingcleanupskyfile -warp_id $stage_id"; # Command to run + $command .= ' -all' if $check_all; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $very_verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + # No skycells were found for some reason. + # it could be that there are no warpSkyfiles at all if say if a run was changed from drop to goto_cleaned + # or of a run was cleaned, set to update, and then back to goto_cleaned before any images were successfully + # updated + my $command = "$warptool -updaterun -warp_id $stage_id -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + + exit(0); + } + $skyfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "warp", $stage_id, $PS_EXIT_PROG_ERROR); + + my $numskycells = scalar @$skyfiles; + print "Found $numskycells to clean\n"; + + my @files = (); + my $num_errors = 0; + my $num_updated = 0; + foreach my $skyfile (@$skyfiles) { + my $path_base = $skyfile->{path_base}; + my $skycell_id = $skyfile->{skycell_id}; + my $data_state = $skyfile->{data_state}; + + my $status = 1; + $status = 0 unless defined $path_base and $path_base ne "NULL"; + + if ($status) { + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PSWARP.CONFIG", $path_base, $skycell_id); + + unless ($ipprc->file_exists($config_file)) { + my $fault = $skyfile->{fault}; + my $quality = $skyfile->{quality}; + if (file_gone($config_file) or !storage_object_exists($config_file)) { + print STDERR "forcing cleanup warp $stage_id $skycell_id fault: $fault quality: $quality" + . " because config file ($config_file) is gone\n"; + } elsif ($fault == 0 and $quality == 0) { + print STDERR "skipping cleaning up warp $stage_id $skycell_id fault: $fault quality: $quality" + . " because config file ($config_file) is missing\n"; + $status = 0; + } else { + # config file is missing but this is a bad warp anyways so clean it + print STDERR "cleaning up warp $stage_id $skycell_id fault: $fault quality: $quality" + . " even though config file ($config_file) is missing\n"; + } + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PSWARP.CONFIG", $path_base, $skycell_id); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping scrubbed for warpRun $stage_id $skycell_id" . + " because config file is present\n"; + $status = 0; + } + } + } + + if ($status) { + # XXX: what is special about quality == 8007? + if ($skyfile->{quality} != 8007 || $check_all) { + my @files = (); + + # delete the temporary image datafiles + addFilename(\@files, "PSWARP.OUTPUT", $path_base, $skycell_id, 1); + addFilename(\@files, "PSWARP.OUTPUT.MASK", $path_base, $skycell_id, 1); + addFilename(\@files, "PSWARP.OUTPUT.VARIANCE", $path_base, $skycell_id, 1); + # these are rebuilt during update so we can delete them here + addFilename(\@files, "PSWARP.OUTPUT.SOURCES", $path_base, $skycell_id); + addFilename(\@files, "SKYCELL.TEMPLATE", $path_base, $skycell_id ); + addFilename(\@files, "PSPHOT.RESID",$path_base,"fpa"); + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename(\@files, "PSWARP.BIN1", $path_base, $skycell_id ); + addFilename(\@files, "PSWARP.BIN2", $path_base, $skycell_id ); + addFilename(\@files, "SKYCELL.STATS", $path_base, $skycell_id ); + addFilename(\@files, "SKYCELL.STATS.UPDATE", $path_base, $skycell_id ); + addFilename(\@files, "PSWARP.CONFIG", $path_base, $skycell_id); + + # XXX: do we want to delete these? trace file is empty + # addFilename(\@files, "TRACE.EXP", $path_base, $skycell_id); + } + # actual command to delete the files + $status = &delete_files (\@files); + } + } + bzip2_file("LOG.EXP", $path_base, $skycell_id); + bzip2_file("LOG.EXP.UPDATE", $path_base, $skycell_id); + + if ($status) { + my $update_skyfile = 1; + my $command = "$warptool -warp_id $stage_id -skycell_id $skycell_id"; + if ($mode eq "goto_purged") { + $command .= " -topurgedskyfile"; + if ($data_state eq 'purged') { + $update_skyfile = 0; + } + } + elsif ($mode eq "goto_cleaned") { + $command .= " -tocleanedskyfile"; + if ($data_state eq 'cleaned') { + $update_skyfile = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -toscrubbedskyfile"; + if ($data_state eq 'scrubbed') { + $update_skyfile = 0; + } + } + $command .= " -dbname $dbname" if defined $dbname; + + if ($update_skyfile) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + + set_destreak_goto_cleaned(); + $num_updated++; + } + + } else { + $num_errors++; + if ($set_error_state_for_file) { + my $command = "$warptool -updateskyfile -warp_id $stage_id -skycell_id $skycell_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + } + + if ($set_error_state_for_run) { + # We want to flag the run as well, to avoid attempting to reprocess the same data over and over again. + $command = "$warptool -warp_id $stage_id -updaterun -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + } + } + } + if (!$set_error_state_for_run or $num_errors eq 0) { + # Set run to done state + my $command = "$warptool -warp_id $stage_id -updaterun -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + } + print "Cleanup completed for warp_id $stage_id. num_updated: $num_updated"; + print " num_errors: $num_errors" if $num_errors; + print "\n"; + exit 0; +} + +### added for cleanup, based on warp stage entry +if ($stage eq 'stack') { + die "--stage_id required for stage stack\n" if !$stage_id; + # this stage uses 'stacktool' + my $stacktool = can_run('stacktool') or die "Can't find stacktool"; + + # Get list of component imfiles + my $skyfiles; # Array reference of component files + my $command = "stacktool -pendingcleanupskyfile -stack_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", "stack", $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + # No skycells were found for some reason. + # Not technically an "error," but a "you told me to do X, and I can't. Please fix this yourself." + my $command = "$stacktool -updaterun -stack_id $stage_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", "stack", $stage_id, $error_code); + } + + exit(0); + } + + $skyfiles = $mdcParser->parse_list(join "", @{ $stdout_buf }) or + &my_die("Unable to parse metadata config doc", "stack", $stage_id, $PS_EXIT_PROG_ERROR); + + my @files = (); + foreach my $skyfile (@{ $skyfiles }) { + my $path_base = $skyfile->{path_base}; + my $skycell_id = $skyfile->{skycell_id}; + + my $status = 1; + if ((!exists($skyfile->{path_base}))|| + (!defined($path_base))) { + $status = 0; + } + if ($status) { + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PPSTACK.CONFIG", $path_base, $skycell_id); + + unless ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for stackRun $stage_id $skycell_id" . + " because config file is missing\n"; + $status = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PPSTACK.CONFIG", $path_base, $skycell_id); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping scrubbed for stackRun $stage_id $skycell_id" . + " because config file is present\n"; + $status = 0; + } + } + } + + if ($status) { + my @files = (); + # delete the temporary image datafiles + addFilename(\@files, "PPSTACK.OUTPUT", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.OUTPUT.MASK", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.OUTPUT.VARIANCE", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.OUTPUT.EXP", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.OUTPUT.EXPNUM", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.OUTPUT.EXPWT", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.UNCONV", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.UNCONV.MASK", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.UNCONV.VARIANCE", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.UNCONV.EXP", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.UNCONV.EXPNUM", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.UNCONV.EXPWT", $path_base, $skycell_id); + + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename(\@files, "PPSTACK.CONV.KERNEL", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.OUTPUT.JPEG1", $path_base, $skycell_id); + addFilename(\@files, "PPSTACK.OUTPUT.JPEG2", $path_base, $skycell_id); + # Commented out to match warp files. + #addFilename(\@files, "PPSTACK.TARGET.PSF", $path_base, $skycell_id); + #addFilename(\@files, "PPSTACK.CONFIG", $path_base, $skycell_id); + } + + $status = &delete_files(\@files); + } + + if ($status) { + my $command = "$stacktool -stack_id $stage_id"; + if ($mode eq "goto_purged") { + $command .= " -updaterun -set_state purged"; + } + elsif ($mode eq "goto_cleaned") { + $command .= " -updaterun -set_state cleaned"; + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -updaterun -set_state scrubbed"; + } + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", "stack", $stage_id, $error_code); + } + + set_destreak_goto_cleaned(); + + } else { + my $command = "$stacktool -updaterun -stack_id $stage_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", "stack", $stage_id, $error_code); + } + } + } + exit 0; +} + +if ($stage eq 'diff') { + + die "--stage_id required for stage diff\n" if !$stage_id; + + # this stage uses 'difftool' + my $difftool = can_run('difftool') or die "Can't find difftool"; + + # Get list of component imfiles + my $skyfiles; # Array reference of component files + my $command = "difftool -pendingcleanupskyfile -diff_id $stage_id"; # Command to run + $command .= ' -all' if $check_all; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $very_verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", "diff", $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + # No skycells were found for some reason. + # it could be that there are no warpSkyfiles at all if say if a run was changed from drop to goto_cleaned + # or of a run was cleaned, set to update, and then back to goto_cleaned before any images were successfully + my $command = "$difftool -updaterun -diff_id $stage_id -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", "diff", $stage_id, $error_code); + } + + exit(0); + } + + $skyfiles = $mdcParser->parse_list(join "", @{ $stdout_buf }) or + &my_die("Unable to parse metadata config doc", "diff", $stage_id, $PS_EXIT_PROG_ERROR); + + my $num_errors = 0; + my $num_updated = 0; + my @files = (); + foreach my $skyfile (@{ $skyfiles }) { + my $path_base = $skyfile->{path_base}; + my $skycell_id = $skyfile->{skycell_id}; + my $data_state = $skyfile->{data_state}; + + my $status = 1; + if ((!exists($skyfile->{path_base}))|| + (!defined($path_base))) { + $status = 0; + } + if ($status) { + + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PPSUB.CONFIG", $path_base, $skycell_id); + + if (0) { + unless ($ipprc->file_exists($config_file)) { + if (file_gone($config_file)) { + print STDERR "forcing cleanup for diffRun $stage_id $skycell_id" . + " because config file ($config_file) is gone\n"; + } else { + print STDERR "skipping cleanup for diffRun $stage_id $skycell_id" . + " because config file ($config_file) is missing\n"; + $status = 0; + } + } + } + unless ($ipprc->file_exists($config_file)) { + my $fault = $skyfile->{fault}; + my $quality = $skyfile->{quality}; + if (file_gone($config_file) or !storage_object_exists($config_file)) { + print STDERR "forcing cleanup diff $stage_id $skycell_id fault: $fault quality: $quality" + . " because config file ($config_file) is gone\n"; + } elsif ($fault == 0 and $quality == 0) { + print STDERR "skipping cleaning up diff $stage_id $skycell_id fault: $fault quality: $quality" + . " because config file ($config_file) is missing\n"; + $status = 0; + } else { + # config file is missing but this is a bad diff anyways so clean it + print STDERR "cleaning up diff $stage_id $skycell_id fault: $fault quality: $quality" + . " even though config file ($config_file) is missing\n"; + } + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PPSUB.CONFIG", $path_base, $skycell_id); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping scrubbed for diffRun $stage_id $skycell_id" . + " because config file ($config_file) is present\n"; + $status = 0; + } + } + } + if ($status) { + my @files = (); + # delete the temporary image datafiles + addFilename(\@files, "PPSUB.OUTPUT", $path_base, $skycell_id, 1); + addFilename(\@files, "PPSUB.OUTPUT.MASK", $path_base, $skycell_id, 1); + addFilename(\@files, "PPSUB.OUTPUT.VARIANCE", $path_base, $skycell_id, 1); + + addFilename(\@files, "PPSUB.INVERSE", $path_base, $skycell_id, 1); + addFilename(\@files, "PPSUB.INVERSE.MASK", $path_base, $skycell_id, 1); + addFilename(\@files, "PPSUB.INVERSE.VARIANCE", $path_base, $skycell_id, 1); + + addFilename(\@files, "PPSUB.INPUT.CONV", $path_base, $skycell_id); + addFilename(\@files, "PPSUB.INPUT.CONV.MASK", $path_base, $skycell_id); + addFilename(\@files, "PPSUB.INPUT.CONV.VARIANCE", $path_base, $skycell_id); + + addFilename(\@files, "PPSUB.REF.CONV", $path_base, $skycell_id); + addFilename(\@files, "PPSUB.REF.CONV.MASK", $path_base, $skycell_id); + addFilename(\@files, "PPSUB.REF.CONV.VARIANCE", $path_base, $skycell_id); + + addFilename(\@files, "PPSUB.OUTPUT.JPEG1", $path_base, $skycell_id); + + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename(\@files, "PPSUB.OUTPUT.KERNELS", $path_base, $skycell_id); + addFilename(\@files, "PPSUB.OUTPUT.JPEG2", $path_base, $skycell_id); + # Commented out to match warp files. + #addFilename(\@files, "PPSUB.CONFIG", $path_base, $skycell_id); + addFilename(\@files, "PPSUB.OUTPUT.SOURCES", $path_base, $skycell_id); + addFilename(\@files, "PPSUB.INVERSE.SOURCES", $path_base, $skycell_id); + + } + $status = &delete_files(\@files); + } + + bzip2_file("LOG.EXP", $path_base, $skycell_id); + bzip2_file("LOG.EXP.UPDATE", $path_base, $skycell_id); + + if ($status) { + my $command = "$difftool -diff_id $stage_id -skycell_id $skycell_id"; + my $update_skyfile = 1; + + if ($mode eq "goto_purged") { + $command .= " -topurgedskyfile"; + if ($data_state eq 'purged') { + $update_skyfile = 0; + } + } + elsif ($mode eq "goto_cleaned") { + $command .= " -tocleanedskyfile"; + if ($data_state eq 'cleaned') { + $update_skyfile = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -toscrubbedskyfile"; + if ($data_state eq 'scrubbed') { + $update_skyfile = 0; + } + } + + $command .= " -dbname $dbname" if defined $dbname; + + if ($update_skyfile) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", "diff", $stage_id, $error_code); + } + set_destreak_goto_cleaned(); + $num_updated++; + } + + + } else { + $num_errors++; + my $command = "$difftool -updatediffskyfile -diff_id $stage_id -skycell_id $skycell_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", "diff", $stage_id, $error_code); + } + + $command = "$difftool -updaterun -diff_id $stage_id -set_state $error_state"; + + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", "diff", $stage_id, $error_code); + } + } + } + if ($num_updated eq 0 and $num_errors eq 0) { + # no skycells were updated by this procedssing so set state to $done_state + my $command = "$difftool -diff_id $stage_id -updaterun -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", "diff", $stage_id, $error_code); + } + } + print "Cleanup completed for diff_id $stage_id. num_updated: $num_updated"; + print " num_errors: $num_errors" if $num_errors; + print "\n"; + exit 0; +} +if ($stage eq 'fake') { + print STDERR "This does not seem to work at present, as no files exist. Terminating quietly.\n"; + exit(0); + die "--stage_id required for stage fake\n" if !$stage_id; + ### select the imfiles for this entry + + # this stage uses 'chiptool' + my $faketool = can_run('faketool') or die "Can't find faketool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $imfiles; # Array of component files + my $command = "$faketool -pendingcleanupimfile -fake_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform faketool: $error_code", "fake", $stage_id, $error_code); + } + + # if there are no fakeProcessedImfiles (@$stdout_buf == 0), the reset the state to 'new' + if (@$stdout_buf == 0) { + my $command = "$faketool -fake_id $stage_id -updaterun -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform faketool: $error_code", "fake", $stage_id, $error_code); + } + exit 0; + } + + # extract the metadata for the files into a hash list + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "fake", $stage_id, $PS_EXIT_PROG_ERROR); + + # loop over all of the imfiles, determine the path_base and class_id for each + foreach my $imfile (@$imfiles) { + my $class_id = $imfile->{class_id}; + my $path_base = $imfile->{path_base}; + my $status = 1; + + # don't clean up unless the data needed to update is available + # modes goto_purged and goto_scrubbed will remove files even if the config is non-existent + # goto_scrubbed now requires the config file to not exist. + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PPSIM.CONFIG", $path_base, $class_id); + + unless ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for fakeRun $stage_id $class_id " + . " because config file is missing\n"; + $status = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PPSIM.CONFIG", $path_base, $class_id); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping scrubbed for fakeRun $stage_id $class_id " + . " because config file is present\n"; + $status = 0; + } + } + + if ($status) { + # array of actual filenames to delete + my @files = (); + + # delete the temporary image datafiles + addFilename (\@files, "PPSIM.OUTPUT.MEF", $path_base, $class_id); + addFilename (\@files, "PPSIM.OUTPUT.SPL", $path_base, $class_id); + addFilename (\@files, "PPSIM.FAKE.CHIP", $path_base, $class_id); + addFilename (\@files, "PPSIM.FORCE.CHIP", $path_base, $class_id); + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PPSIM.SOURCES", $path_base, $class_id); + addFilename (\@files, "PPSIM.FAKE.SOURCES", $path_base, $class_id); + addFilename (\@files, "PPSIM.FORCE.SOURCES", $path_base, $class_id); + } + + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + my $command = "$faketool -fake_id $stage_id -class_id $class_id"; + if ($mode eq "goto_purged") { + $command .= " -topurgedimfile"; + } + elsif ($mode eq "goto_cleaned") { + $command .= " -tocleanedimfile"; + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -toscrubbedimfile"; + } + + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform faketool: $error_code", "fake", $stage_id, $error_code); + } + } else { + + # if an error happens for one chip, the chipRun will stay in goto_*, but the chips will go to error_* (matching the goto_*) + my $command = "$faketool -updateprocessedimfile -fake_id $stage_id -class_id $class_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform faketool: $error_code", "fake", $stage_id, $error_code); + } + } + } + exit 0; + +} +# Detrend stages +if ($stage eq "detrend.processed") { + + die "--stage_id required for stage detrend.process.imfile\n" if !$stage_id; + ### select the imfiles for this entry + + # Neither det_id nor exp_id uniquely determine a det exposure, so we pack them. + my ($det_id,$exp_id) = split /\./, $stage_id; #/ trailing slash for emacs; + + # this stage uses 'dettool' + my $dettool = can_run('dettool') or die "Can't find chiptool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $imfiles; # Array of component files + my $metadata; + my $command = "$dettool -pendingcleanup_processedimfile -det_id $det_id -exp_id $exp_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "detrend.processed", $stage_id, $error_code); + } + + # if there are no detProcessedImfiles (@$stdout_buf == 0), the reset the state to 'new' + if (@$stdout_buf != 0) { +# exit 0; # Silently exit if there's nothing to do. I don't know how we'd ever get here, but let's be safe. + + + # extract the metadata for the files into a hash list + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR); + } + # loop over all of the imfiles, determine the path_base and class_id for each + foreach my $imfile (@$imfiles) { + my $iexp_id = $imfile->{exp_id}; + my $class_id = $imfile->{class_id}; + my $path_base = $imfile->{path_base}; + my $status = 1; + + unless (defined($path_base)) { + print STDERR "PATH BASE: >>$path_base<< didn't get defined for $iexp_id $exp_id $det_id $class_id\n"; + $status = 0; + } + unless (defined($class_id)) { + print STDERR "CLASS_ID: >>$class_id<< didn't get defined for $iexp_id $exp_id $det_id $path_base\n"; + $status = 0; + } + # Detrends cannot be updated, so goto_cleaned and goto_scrubbed are treated as equivalent, + # and so there is no check for config files. + if ($status) { + # array of actual filenames to delete + my @files = (); + # delete the temporary image datafiles + addFilename (\@files, "PPIMAGE.OUTPUT", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.OUTPUT.MASK", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.OUTPUT.VARIANCE", $path_base, $class_id); + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PPIMAGE.BIN1", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.BIN2", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.STATS", $path_base, $class_id); + } + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + my $command = "$dettool -det_id $det_id -exp_id $iexp_id -class_id $class_id -updateprocessedimfile"; + if ($mode eq "goto_purged") { + $command .= " -data_state purged"; + } + elsif ($mode eq "goto_cleaned") { + $command .= " -data_state cleaned"; + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -data_state scrubbed"; + } + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + + } else { + # if an error happens for one chip, the chipRun will stay in goto_*, but the chips will go to error_* + my $command = "$dettool -det_id $det_id -exp_id $iexp_id -class_id $class_id -updateprocessedimfile "; + $command .= " -data_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + } + } + + # Flag the detProcessedExp as clean now as well, if it is marked to be cleaned (this is clunky, but works for now). + + $command = "$dettool -pendingcleanup_processedexp -det_id $det_id -exp_id $exp_id"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detProcessedExp)", $stage_id, $error_code); + } + if (@$stdout_buf != 0) { + my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage (detProcessedExp)", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $exp_id = $exp->{exp_id}; + my $command = "$dettool -updateprocessedexp -det_id $det_id -exp_id $exp_id "; + if ($mode eq "goto_cleaned") { + $command .= " -data_state cleaned "; + } + if ($mode eq "goto_scrubbed") { + $command .= " -data_state scrubbed "; + } + if ($mode eq "goto_purged") { + $command .= " -data_state purged "; + } + $command .= " -dbname $dbname" if defined $dbname; +# print "$command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detProcessedExp)", $stage_id, $error_code); + } + } + } + + exit 0; +} +if ($stage eq "detrend.resid") { + + die "--stage_id required for stage $stage\n" if !$stage_id; + ### select the imfiles for this entry + + # Neither det_id nor exp_id uniquely determine the det exposure, so we pack them + my ($det_id,$exp_id) = split /\./, $stage_id; #/ trailing slash for emacs; + + # this stage uses 'dettool' + my $dettool = can_run('dettool') or die "Can't find dettool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $imfiles; # Array of component files + my $metadata; + my $command = "$dettool -pendingcleanup_residimfile -det_id $det_id -exp_id $exp_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "detrend.process.imfile", $stage_id, $error_code); + } + + # if there are no detResidImfiles (@$stdout_buf == 0), then silently exit. + if (@$stdout_buf != 0) { + # extract the metadata for the files into a hash list + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR); + } + # loop over all of the imfiles, determine the path_base and class_id for each + foreach my $imfile (@$imfiles) { + my $iexp_id = $imfile->{exp_id}; + my $class_id = $imfile->{class_id}; + my $path_base = $imfile->{path_base}; + my $iteration = $imfile->{iteration}; + + my $status = 1; + + # Detrends cannot be updated, so goto_cleaned and goto_scrubbed are treated as equivalent, + # and so there is no check for config files. + unless (defined($path_base)) { + print STDERR "PATH BASE: >>$path_base<< didn't get defined for $iexp_id $exp_id $det_id $class_id\n"; + $status = 0; + } + unless (defined($class_id)) { + print STDERR "CLASS_ID: >>$class_id<< didn't get defined for $iexp_id $exp_id $det_id $path_base\n"; + $status = 0; + } + if ($status) { + # array of actual filenames to delete + my @files = (); + + # delete the temporary image datafiles + addFilename (\@files, "PPIMAGE.OUTPUT", $path_base, $class_id); + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PPIMAGE.BIN1", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.BIN2", $path_base, $class_id); + addFilename (\@files, "PPIMAGE.STATS", $path_base, $class_id); + } +# foreach my $f (@files) { +# print "RESID: $f\n"; +# } + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + my $command = "$dettool -det_id $det_id -exp_id $iexp_id -iteration $iteration -class_id $class_id -updateresidimfile "; + if ($mode eq "goto_purged") { + $command .= " -data_state purged"; + } + elsif ($mode eq "goto_cleaned") { + $command .= " -data_state cleaned"; + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -data_state scrubbed"; + } + + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + } else { + my $command = "$dettool -det_id $det_id -exp_id $iexp_id -iteration $iteration -class_id $class_id -updateresidimfile "; + $command .= " -data_state $error_state "; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + } + } + # Flag the detResidExp as clean now as well, if it is marked tobe cleaned (this is still clunky). + + $command = "$dettool -pendingcleanup_residexp -det_id $det_id -exp_id $exp_id"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detResidExp)", $stage_id, $error_code); + } + if (@$stdout_buf != 0) { + my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage (detResidExp)", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $iteration = $exp->{iteration}; + my $command = "$dettool -updateresidexp -det_id $det_id -exp_id $exp_id "; + if ($mode eq "goto_cleaned") { + $command .= " -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command .= " -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command .= " -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detResidExp)", $stage_id, $error_code); + } + } + } + + exit 0; +} + +if ($stage eq "detrend.stack.imfile") { + + die "--stage_id required for stage $stage\n" if !$stage_id; + + # this stage uses 'dettool' + my $dettool = can_run('dettool') or die "Can't find dettool"; + + # Get list of component imfiles + my $stacks; # Array reference of component files + my $command = "$dettool -pendingcleanup_stacked -det_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + $stacks = $mdcParser->parse_list(join "", @{ $stdout_buf }) or + &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR); + + my @files = (); + foreach my $stack (@{ $stacks }) { + # detStackedImfile does not have a path_base column. This is inconvenient, as it means we need to calculate it. + my $path_base = $stack->{uri}; + my $iteration = $stack->{iteration}; + my $class_id = $stack->{class_id}; + + $path_base =~ s/\.fits$//; # That should do it? + + my $status = 1; + + if ($status) { + my @files = (); + # delete the temporary image datafiles + # There's no convenient way to get the detrend type, so I'm queueing all of them for deletion. + # I understand that they all point to the same filename right now, but that may not be true in + # the future. + addFilename(\@files, "PPMERGE.OUTPUT.MASK", $path_base, $stage_id); + addFilename(\@files, "PPMERGE.OUTPUT.BIAS", $path_base, $stage_id); + addFilename(\@files, "PPMERGE.OUTPUT.DARK", $path_base, $stage_id); + addFilename(\@files, "PPMERGE.OUTPUT.SHUTTER", $path_base, $stage_id); + addFilename(\@files, "PPMERGE.OUTPUT.FLAT", $path_base, $stage_id); + addFilename(\@files, "PPMERGE.OUTPUT.FRINGE", $path_base, $stage_id); + + + addFilename(\@files, "PPMERGE.OUTPUT.SIGMA", $path_base, $stage_id); + addFilename(\@files, "PPMERGE.OUTPUT.COUNT", $path_base, $stage_id); + + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode +# addFilename(\@files, "PPMERGE.OUTPUT", $path_base, $stage_id); + } + + $status = &delete_files(\@files); + } + + if ($status) { + my $command = "$dettool -det_id $stage_id -iteration $iteration -class_id $class_id"; + if ($mode eq "goto_purged") { + $command .= " -updatestacked -data_state purged"; + } + elsif ($mode eq "goto_cleaned") { + $command .= " -updatestacked -data_state cleaned"; + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -updatestacked -data_state scrubbed"; + } + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + } else { + my $command = "$dettool -updatestacked -det_id $stage_id -iteration $iteration -class_id $class_id -data_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + exit $PS_EXIT_UNKNOWN_ERROR; + } + } + # Check to see if we can mark the whole detRunSummary object as cleaned. + + $command = "$dettool -pendingcleanup_detrunsummary -det_id $stage_id"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + if (@$stdout_buf != 0) { + my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $iteration = $exp->{iteration}; + my $command; + if ($mode eq "goto_cleaned") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + } + } + exit 0; +} +if ($stage eq "detrend.normstat.imfile") { + print STDERR "I'm not convinced there's anything to clean up from stage $stage\n"; + die "--stage_id required for stage $stage\n" if !$stage_id; + # this stage uses 'camtool' + my $dettool = can_run('dettool') or die "Can't find dettool"; + + my $command = "$dettool -pendingcleanup_normalizedstat -det_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + my $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { +# my $path_base = $exp->{path_base}; + my $iteration = $exp->{iteration}; + my $class_id = $exp->{class_id}; + + my $status = 1; + if ($status) { + my $command = "$dettool -updatenormalizedstat -det_id $stage_id -iteration $iteration -class_id $class_id"; + if ($mode eq "goto_cleaned") { + $command .= " -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command .= " -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command .= " -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + } else { + my $command = "$dettool -updatenormalizedstat -det_id $stage_id -iteration $iteration -class_id $class_id -data_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + exit $PS_EXIT_UNKNOWN_ERROR; + } + } + # Check to see if we can mark the whole detRunSummary object as cleaned. + + $command = "$dettool -pendingcleanup_detrunsummary -det_id $stage_id"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + if (@$stdout_buf != 0) { + $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $iteration = $exp->{iteration}; + my $command; + if ($mode eq "goto_cleaned") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + } + } + + exit 0; + +} +if ($stage eq "detrend.norm.imfile") { + die "--stage_id required for stage $stage\n" if !$stage_id; + # this stage uses 'dettool' + my $dettool = can_run('dettool') or die "Can't find dettool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $exps; # Array of component files + my $command = "$dettool -pendingcleanup_normalizedimfile -det_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $path_base = $exp->{path_base}; + my $iteration = $exp->{iteration}; + my $class_id = $exp->{class_id}; + + my $status = 1; + # don't clean up unless the data needed to update is available + # goto_scrubbed now requires the config file to not be present + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PPIMAGE.CONFIG", $path_base); + + unless ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for $stage $stage_id because config file is missing\n"; + $status = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PPIMAGE.CONFIG", $path_base); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for $stage $stage_id because config file ($config_file) is present\n"; + $status = 0; + } + } + if ($status) { + my @files = (); + + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PPIMAGE.OUTPUT.FPA1", $path_base); + addFilename (\@files, "PPIMAGE.OUTPUT.FPA2", $path_base); + + addFilename (\@files, "PPIMAGE.OUTPUT", $path_base); + addFilename (\@files, "PPIMAGE.STATS", $path_base); + } + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + my $command = "$dettool -updatenormalizedimfile -det_id $stage_id -iteration $iteration -class_id $class_id"; + if ($mode eq "goto_cleaned") { + $command .= " -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command .= " -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command .= " -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + } else { + my $command = "$dettool -updatenormalizedimfile -det_id $stage_id -iteration $iteration -class_id $class_id -data_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + exit $PS_EXIT_UNKNOWN_ERROR; + } + } + # Check to see if we can mark the whole detRunSummary object as cleaned. + + $command = "$dettool -pendingcleanup_detrunsummary -det_id $stage_id"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + if (@$stdout_buf != 0) { + $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $iteration = $exp->{iteration}; + my $command; + if ($mode eq "goto_cleaned") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + } + } + + exit 0; +} +if ($stage eq "detrend.norm.exp") { + die "--stage_id required for stage $stage\n" if !$stage_id; + # this stage uses 'dettool' + my $dettool = can_run('dettool') or die "Can't find dettool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $exps; # Array of component files + my $command = "$dettool -pendingcleanup_normalizedexp -det_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + exit 0; + } + $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $exp_id = $exp->{exp_id}; + my $iteration = $exp->{iteration}; + my $path_base = $exp->{path_base}; + + my $status = 1; + # don't clean up unless the data needed to update is available + # goto_scrubbed now requires the config file to not be present + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PPIMAGE.CONFIG", $path_base); + + unless ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for $stage $stage_id because config file is missing\n"; + $status = 0; + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PPIMAGE.CONFIG", $path_base); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping cleanup for $stage $stage_id because config file ($config_file) is present\n"; + $status = 0; + } + } + if ($status) { + my @files = (); + # delete the temporary image datafiles + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PPIMAGE.JPEG1", $path_base); + addFilename (\@files, "PPIMAGE.JPEG2", $path_base); + } + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + my $command = "$dettool -updatenormalizedexp -det_id $stage_id -iteration $iteration"; + if ($mode eq "goto_cleaned") { + $command .= " -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command .= " -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command .= " -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + print STDERR " residexp had an issue setting the state:? $success $error_code\n"; + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + } else { + my $command = "$dettool -updatenormalizedexp -det_id $stage_id -exp_id $exp_id -iteration $iteration -data_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage", $stage_id, $error_code); + } + exit $PS_EXIT_UNKNOWN_ERROR; + } + } + # Check to see if we can mark the whole detRunSummary object as cleaned. + + $command = "$dettool -pendingcleanup_detrunsummary -det_id $stage_id"; + $command .= " -dbname $dbname" if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + if (@$stdout_buf != 0) { + $exps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "$stage (detRunSummary)", $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $exp (@$exps) { + my $iteration = $exp->{iteration}; + my $command; + if ($mode eq "goto_cleaned") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state cleaned"; + } + if ($mode eq "goto_scrubbed") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state scrubbed"; + } + if ($mode eq "goto_purged") { + $command = "$dettool -updatedetrunsummary -det_id $stage_id -iteration $iteration -data_state purged"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", "$stage (detRunSummary)", $stage_id, $error_code); + } + } + } + exit 0; +} + +if ($stage eq "chip_bg") { + + die "--stage_id required for stage chip_bg\n" if !$stage_id; + + &my_die("only mode goto_cleaned is supported for stage chip_bg", "chip_bg", $stage_id, $PS_EXIT_PROG_ERROR) + if $mode ne 'goto_cleaned'; + + ### select the imfiles for this entry + + # this stage uses 'bgtool' + my $bgtool = can_run('bgtool') or die "Can't find bgtool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $imfiles; # Array of component files + my $command = "$bgtool -pendingcleanupchipimfile -chip_bg_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "chip_bg", $stage_id, $error_code); + } + + # XXX: Is not having any files to process really a bug? NO + if (0 and @$stdout_buf == 0) { + my $command = "$bgtool -chip_bg_id $stage_id -updatechip -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "chip_bg", $stage_id, $error_code); + } + exit 0; + } + + # extract the metadata for the files into a hash list + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "chip_bg", $stage_id, $PS_EXIT_PROG_ERROR); + + # loop over all of the imfiles, determine the path_base and class_id for each + my $num_errors = 0; + my $num_updated = 0; + foreach my $imfile (@$imfiles) { + my $class_id = $imfile->{class_id}; + my $path_base = $imfile->{path_base}; + my $status = 1; + $status = 0 unless defined $path_base and $path_base ne "NULL"; + + # don't clean up unless the data needed to update is available + # modes goto_purged and goto_scrubbed will remove files even if the config is non-existent + # goto_scrubbed now requires the config file to not exist. + if ($status) { + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PPBACKGROUND.CONFIG", $path_base, $class_id); + + unless ($ipprc->file_exists($config_file)) { + if (file_gone($config_file)) { + print STDERR "forcing cleanup for chipRun $stage_id $class_id " + . " because config file ($config_file) is gone\n"; + } else { + print STDERR "skipping cleanup for chipRun $stage_id $class_id " + . " because config file ($config_file) is missing\n"; + $status = 0; + } + } + } + elsif ($mode eq "goto_scrubbed") { + my $config_file = $ipprc->filename("PPBACKGROUND.CONFIG", $path_base, $class_id); + + if ($ipprc->file_exists($config_file)) { + print STDERR "skipping scrubbed for chipBackgroundRun $stage_id $class_id " + . " because config file ($config_file) is present\n"; + $status = 0; + } + } + } + + if ($status) { + # array of actual filenames to delete + my @files = (); + + # delete the image datafiles + addFilename (\@files, "PPBACKGROUND.OUTPUT", $path_base, $class_id); + addFilename (\@files, "PPBACKGROUND.OUTPUT.MASK", $path_base, $class_id); + addFilename (\@files, "PPBACKGROUND.OUTPUT.VARIANCE", $path_base, $class_id); + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PPBACKGROUND.STATS", $path_base, $class_id); #clean? + addFilename (\@files, "PPBACKGOROUND.CONFIG", $path_base, $class_id); + } + + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + $num_updated++; + my $command = "$bgtool -chip_bg_id $stage_id -class_id $class_id"; + if ($mode eq "goto_cleaned") { + $command .= " -tocleanedchipimfile"; + } + elsif ($mode eq "goto_purged") { + $command .= " -topurgedchipimfile"; + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -toscrubbedchipimfile"; + } + + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", "chip", $stage_id, $error_code); + } + + } else { + $num_errors++; + + if ($set_error_state_for_file) { + # if an error happens for one chip, the chipBackgroundRun will stay in goto_*, but the chips will go to error_* (matching the goto_*) + my $command = "$bgtool -updatechipimfile -chip_bg_id $stage_id -class_id $class_id -set_data_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "chip_bg", $stage_id, $error_code); + } + } + if ($set_error_state_for_run) { + + # We want to flag the run as well, to avoid attempting to reprocess the same data over and over again. + $command = "$bgtool -chip_bg_id $stage_id -updatechip -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", "chip", $stage_id, $error_code); + } + + } + } + } + if (!$set_error_state_for_run or ($num_errors eq 0)) { + # Set run to done state + my $command = "$bgtool -chip_bg_id $stage_id -updatechip -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + } + print "Cleanup completed for chip_bg_id $stage_id. num_updated: $num_updated"; + print " num_errors: $num_errors" if $num_errors; + print "\n"; + exit 0; +} +if ($stage eq "warp_bg") { + + die "--stage_id required for stage warp_bg\n" if !$stage_id; + + &my_die("only mode goto_cleaned is supported for stage warp_bg", "warp_bg", $stage_id, $PS_EXIT_PROG_ERROR) + if $mode ne 'goto_cleaned'; + + ### select the imfiles for this entry + + # this stage uses 'bgtool' + my $bgtool = can_run('bgtool') or die "Can't find bgtool"; + + # Get list of component imfiles + # XXX may need a different my_die for each stage + my $imfiles; # Array of component files + my $command = "$bgtool -pendingcleanupwarpskyfile -warp_bg_id $stage_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "warp_bg", $stage_id, $error_code); + } + + # XXX: Is not having any files to process really a bug? NO + if (0 and @$stdout_buf == 0) { + my $command = "$bgtool -warp_bg_id $stage_id -updatewarp -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "warp_bg", $stage_id, $error_code); + } + exit 0; + } + + # extract the metadata for the files into a hash list + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", "warp_bg", $stage_id, $PS_EXIT_PROG_ERROR); + + # loop over all of the imfiles, determine the path_base and skycell_id for each + my $num_errors = 0; + my $num_updated = 0; + foreach my $imfile (@$imfiles) { + my $skycell_id = $imfile->{skycell_id}; + my $path_base = $imfile->{path_base}; + my $status = 1; + $status = 0 unless defined $path_base and $path_base ne "NULL"; + + # don't clean up unless the data needed to update is available + # modes goto_purged and goto_scrubbed will remove files even if the config is non-existent + # goto_scrubbed now requires the config file to not exist. + if ($status) { + if ($mode eq "goto_cleaned") { + my $config_file = $ipprc->filename("PSWARP.CONFIG", $path_base, $skycell_id); + + unless ($ipprc->file_exists($config_file)) { + if (file_gone($config_file)) { + print STDERR "forcing cleanup for warpBackgroundSkyfile $stage_id $skycell_id " + . " because config file ($config_file) is gone\n"; + } elsif ($imfile->{fault}) { + print STDERR "forcing cleanup for faulted warpBackgroundSkyfile\n"; + } else { + print STDERR "skipping cleanup for warpBackgroundSkyfile $stage_id $skycell_id " + . " because config file ($config_file) is missing\n"; + $status = 0; + } + } + } + } + + if ($status) { + # array of actual filenames to delete + my @files = (); + + # delete the image datafiles + addFilename (\@files, "PSWARP.OUTPUT", $path_base, $skycell_id); + addFilename (\@files, "PSWARP.OUTPUT.MASK", $path_base, $skycell_id); + addFilename (\@files, "PSWARP.OUTPUT.VARIANCE", $path_base, $skycell_id); + if ($mode eq "goto_purged") { + # additional files to remove for 'purge' mode + addFilename (\@files, "PSWARP.STATS", $path_base, $skycell_id); #clean? + addFilename (\@files, "PSWARP.CONFIG", $path_base, $skycell_id); + } + + # actual command to delete the files + $status = &delete_files (\@files); + } + + if ($status) { + $num_updated++; + my $command = "$bgtool -warp_bg_id $stage_id -skycell_id $skycell_id"; + # recall that only goto_cleaned is supported (currently) + if ($mode eq "goto_cleaned") { + $command .= " -tocleanedwarpskyfile"; + } + elsif ($mode eq "goto_purged") { + $command .= " -topurgedwarpskyfile"; + } + elsif ($mode eq "goto_scrubbed") { + $command .= " -toscrubbedwarpskyfile"; + } + + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "warp", $stage_id, $error_code); + } + + } else { + + $num_errors++; + + # NOTE: bgtool does not support -updatewarpskyfile + if (0) { + # if an error happens for one skycell, the warpBackgroundRun will stay in goto_*, but the skycells will go to error_* (matching the goto_*) + my $command = "$bgtool -updatewarpskyfile -warp_bg_id $stage_id -skycell_id $skycell_id -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "warp_bg", $stage_id, $error_code); + } + } + + if ($set_error_state_for_run) { + + # We want to flag the run as well, to avoid attempting to reprocess the same data over and over again. + $command = "$bgtool -warp_bg_id $stage_id -updatewarp -set_state $error_state"; + $command .= " -dbname $dbname" if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform bgtool: $error_code", "warp", $stage_id, $error_code); + } + } + } + } + if (($num_errors == 0) || !$set_error_state_for_run) { + # Set run to done state + my $command = "$bgtool -warp_bg_id $stage_id -updatewarp -set_state $done_state"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", "warp", $stage_id, $error_code); + } + } + print "Cleanup completed for warp_bg_id $stage_id. num_updated: $num_updated"; + print " num_errors: $num_errors" if $num_errors; + print "\n"; + exit 0; +} + +die "ipp_cleanup.pl -stage $stage not yet implemented\n"; + +sub delete_files +{ + my $files = shift; # reference to a list of files to unlink + + foreach my $file (@$files) { + print STDERR "unlinking $stage $stage_id $file\n" if $very_verbose; + + my $error_code = $ipprc->kill_file($file); + + &my_die("failed to kill $file", $stage, $stage_id, $PS_EXIT_CONFIG_ERROR) if $error_code; + } + + return 1; +} + +my $whichnode; +sub file_gone +{ + # if $check_for_gone check whether the only instance of file is on a lost volume + # XXX: we don't have a proper interface for this. + # For now try to use Bill's hack the script 'whichnode' + return 0 if !$check_for_gone; + + my $file = shift; + + if (file_scheme($file) ne 'neb') { + return 0; + } + + if (!$whichnode) { + $whichnode = can_run('whichnode') or + &my_die("Can't find whichnode", "chip", $stage_id, $PS_EXIT_CONFIG_ERROR); + } + + my $command = "$whichnode $file"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform whichnode: $error_code", "chip", $stage_id, $error_code); + } + + my @lines = split "\n", (join "", @$stdout_buf); + my $numGone = 0; + my $numNotGone = 0; + foreach my $line (@lines) { + chomp $line; + + # output lines are either + # "volume available" + # or + # "volume not available" + + my ($volume, $answer, undef) = split " ", $line; + # our hack is if the volume has an X in the name it's gone + if ($volume =~ /X/) { + print STDERR "$file is on $volume which is gone\n"; + $numGone++; + } elsif ($answer eq 'available') { + $numNotGone++; + } elsif ($answer eq 'not') { + print STDERR "$file is on $volume which is not available\n"; + $numNotGone++; + } else { + print STDERR "unexpected output from whichnode: $line\n"; + } + } + # if there are any instances that are not on a gone node return 0 + if ($numNotGone == 0 and $numGone > 0) { + return 1; + } else { + return 0; + } +} + +sub addFilename +{ + my $files = shift; # reference to a list of files to unlink + my $filerule = shift; # filerule to add + my $path_base = shift; # base filename + my $class_id = shift; # class_id, if needed + my $recovery = shift; # is there is a recovery file to clean? + + my $file = $ipprc->filename($filerule, $path_base, $class_id); + + push @$files, $file; + + if ($recovery) { + # need to clean up the recovery file (the pixels censored by streaksremove) + $file = $ipprc->recovery_filename($file); + push @$files, $file; + } + return 1; +} + +sub set_destreak_goto_cleaned { + + return if $ds_done; + + # Tell magicdstool that we've cleaned up this data, so it needs to do the same if it needs to do the same. + my $magicdstool = can_run('magicdstool') or die "Can't find magicdstool"; + my $command = "$magicdstool -stage $stage -stage_id $stage_id -updaterun -set_state goto_cleaned -set_label goto_cleaned"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magicdstool: $error_code", "$stage", $stage_id, $error_code); + } + $ds_done = 1; +} + +sub bzip2_file { + my $filerule = shift; + my $path_base = shift; + my $component = shift; + + my $filename = $ipprc->filename($filerule, $path_base, $component); + if (!$ipprc->file_exists($filename)) { + return 1; + } + if (my $resolved = $ipprc->file_resolve($filename)) { + my $bzip2_filename = $filename . '.bz2'; + if (file_scheme($bzip2_filename) eq 'neb') { + # XXX: GRRRR $ipprc->file_exists() returns false if storage object exists but instance has + # size of zero + $nebulous_server = $ipprc->nebulous() if !$nebulous_server; + if ($nebulous_server->storage_object_exists($bzip2_filename)) { + print STDERR "$bzip2_filename exists, killing\n"; + $ipprc->kill_file($bzip2_filename); + } else { + print STDERR "$bzip2_filename does not exist\n" if $very_verbose; + } + } else { + if ($ipprc->file_exists($bzip2_filename)) { + print STDERR "$bzip2_filename exists, killing\n"; + $ipprc->kill_file($bzip2_filename); + } else { + print STDERR "$bzip2_filename does not exist\n" if $very_verbose; + } + } + my $bzip2_file = $ipprc->file_create($bzip2_filename); + my_die("Unable to create $bzip2_filename", $stage_id, $stage_id, $PS_EXIT_SYS_ERROR) unless $bzip2_file; + + my $command = "$bzip2 < $resolved > $bzip2_file"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $very_verbose); + if ($success) { + # success delete the original file + my $error_code = $ipprc->kill_file($filename); + } else { + # if bzip2 failed. Carry on but don't delete the existing file + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + print STDERR "Failed to bzip2 $filename: $error_code\n"; + return 0; + } + } + return 1; +} + +sub storage_object_exists { + my $filename = shift; + $nebulous_server = $ipprc->nebulous() if !$nebulous_server; + return $nebulous_server->storage_object_exists($filename); +} + +# XXX we currently do not set the error state in the db on my_die +sub my_die +{ + my $msg = shift; # Warning message on die + my $stage = shift; # stage name + my $stage_id = shift; # identifier + my $exit_code = shift; # Exit code + # outputImage and path_base are globals + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_cluster_load_monitor.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_cluster_load_monitor.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_cluster_load_monitor.pl (revision 41105) @@ -0,0 +1,40 @@ +#! /usr/bin/env perl + +use warnings; +use strict; +use Sys::Hostname; +use DateTime; + +my $sleep_period = 30; + + +my $host = hostname(); +my $logdir = "/tmp/load_monitor"; + +my $current_date = 999; + +while (1) { + my $dt = DateTime->now; + if ($dt->day != $current_date) { + my $del_dt = DateTime->now; + $del_dt->subtract( days => 4 ); + my $del_stamp = sprintf("%04d%02d%02d.\*",$del_dt->year,$del_dt->month,$del_dt->day); + my_system("rm ${logdir}/load.${host}.$del_stamp"); + } + + my $stamp = sprintf("%04d%02d%02d.%02d%02d%02d",$dt->year,$dt->month,$dt->day,$dt->hour,$dt->minute,$dt->second); + my $outfile = "${logdir}/load.${host}.$stamp"; + + my_system("uptime > $outfile"); + my_system("ps aux >> $outfile"); + + $current_date = $dt->day; + sleep($sleep_period); +} + +sub my_system { + my $cmd = shift; +# print ">>$cmd<<\n"; + system("$cmd"); +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_darkstats.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_darkstats.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_darkstats.pl (revision 41105) @@ -0,0 +1,188 @@ +#!/usr/bin/env perl + +# use warnings; +# use strict; +use Carp; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use IPC::Cmd 0.36 qw( can_run run ); +use IO::Handle; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +my ($dbname, $det_id, $camera); + +GetOptions('dbname=s' => \$dbname, + 'det_id=s' => \$det_id, + 'camera|c=s' => \$camera, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "USAGE: ipp_darkstats.pl --dbname (name) --det_id (id) --camera (name)", + -exitval => 3, + ) unless defined $dbname and defined $det_id and defined $camera; + +$ipprc->define_camera($camera); + +### Get list of dark imfile results + +# define the dettool command +my $command = "dettool -processedimfile -select_state stop"; # Command to run +$command .= " -det_id $det_id"; +$command .= " -dbname $dbname" if defined $dbname; + +# run the dettool command and catch the output +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", $error_code); +} + +# parse the output into a list +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $PS_EXIT_PROG_ERROR); +my $list = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $PS_EXIT_PROG_ERROR); + +my @bg_data; +my @bg_stdev_data; +my @bg_name; +my @bg_exptime; +my %components; + +print STDERR "extracted the data from the database\n"; + +# we now have a list of imfiles; we need to extract the background for each cell +# from the stats files for each imfile +foreach my $item (@$list) { + my $path_base = $item->{path_base}; + my $class_id = $item->{class_id}; + my $exp_time = $item->{exp_time}; + + my $rootName = $ipprc->file_resolve ($path_base); + my $statsName = "$rootName.$class_id.stats"; + + # print STDERR "rootName: $rootName : $exp_time\n"; + print STDERR "statsName: $statsName : $exp_time\n"; + + my $statsFile; + open $statsFile, $statsName; + my @contents = <$statsFile>; + close ($statsFile); + + # print STDERR "contents: @contents\n"; + + my $parser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $statsList = $parser->parse(join "", @contents) or &my_die("Unable to parse metadata for imfile stats", $PS_EXIT_SYS_ERROR); + + &parse_stats_table ($exp_time, $class_id, $statsList); +} + +print STDERR "parsed the stats from the data files\n"; + +for (my $i = 0; $i < @bg_data; $i++) { + $nameX = "$bg_name[$i].exp"; + $nameY = "$bg_name[$i].bg"; + push @{$nameX}, $bg_exptime[$i]; + push @{$nameY}, $bg_data[$i]; +} + +if (-e "output.dat") { unlink "output.dat"; } + +print STDERR "dumping stats\n"; +open (MANA, "|mana --norc"); +MANA->autoflush; + +foreach my $component (@components) { + $nameX = "$component.exp"; + $nameY = "$component.bg"; + + print MANA "delete X Y\n"; + + open (DATA, ">$component.dat"); + for (my $i = 0; $i < @{$nameX}; $i++) { + print DATA "${$nameX}[$i] ${$nameY}[$i]\n"; + } + close (DATA); + + print MANA "data $component.dat\n"; + print MANA "read X 1 Y 2\n"; + print MANA "fit X Y 2 -clip 3 3\n"; + print MANA "output output.dat\n"; + print MANA "echo $component METADATA\n"; + print MANA "echo \" NORDER_X S32 2 \"\n"; + print MANA "echo \" VAL_X00 F64 \$C0\"\n"; + print MANA "echo \" VAL_X01 F64 \$C1\"\n"; + print MANA "echo \" VAL_X02 F64 \$C2\"\n"; + print MANA "echo \" NELEMENTS S32 3 \"\n"; + print MANA "echo END\n"; + print MANA "echo\n"; + print MANA "output stdout\n"; + + print MANA "applyfit X Yf\n"; + print MANA "lim X Y\n"; + print MANA "clear\n"; + print MANA "box\n"; + print MANA "plot -x 2 -pt 2 -sz 1.0 -c black X Y\n"; + print MANA "plot -x 2 -pt 7 -sz 1.0 -c red X Yf\n"; + + print STDERR "hit return to continue\n"; + $answer = ; +} + +close (MANA); + +exit 0; + +sub parse_stats_table +{ + my ($exp_time, $tag, $md) = @_; + + # descend through the fpa + foreach my $entry (@$md) { + # print STDERR "name: $entry->{name}, class: $entry->{class}\n"; + # recurse on nested metadata + if ($entry->{class} eq 'metadata') { + my $newtag = $tag . "_" . $entry->{name}; + &parse_stats_table ($exp_time, $newtag, $entry->{value}); + } + + if ($entry->{name} =~ /^(SAMPLE|ROBUST|FITTED|CLIPPED)/) { + # It's a statistic of some sort + if ($entry->{name} =~ /_STDEV$/) { + push @bg_stdev_data, $entry->{value}; + } else { + push @bg_name, $tag; + push @bg_data, $entry->{value}; + push @bg_exptime, $exp_time; + # print STDERR "$tag $exp_time $entry->{value}\n"; + } + if (!$componentsHash{$tag}) { + push @components, $tag; + $componentsHash{$tag} = 1; + } + next; + } + } + return 1; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $exit_code = shift; # Exit code to add + + carp($msg); + exit $exit_code; +} + +# - get the exp_time as well from dettool +# - build an array of bg & exptime for each cell +# - fit the trend (in mana? pslib functions?) +# - write the polynomial for each cell Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_datapath.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_datapath.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_datapath.pl (revision 41105) @@ -0,0 +1,25 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); + +use PS::IPP::Config; +my $ipprc = PS::IPP::Config->new(); + +my $touch; + +GetOptions( + 'touch' => \$touch, +); + +die "No filename specified.\n" if scalar @ARGV != 1; + +my $filename = shift @ARGV; + +my $resolved = $ipprc->file_resolve($filename, $touch); +print "$resolved\n" if ($resolved); + +1; + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_detrend_combine.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_detrend_combine.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_detrend_combine.pl (revision 41105) @@ -0,0 +1,221 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Data::Dumper; +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use PS::IPP::Metadata::Stats; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my $RECIPE_PPSTATS = 'CHIPSTATS'; # Recipe to use with ppStats + +# Parse command-line arguments +my ($det_type, $filelevel, $inst, $telescope, $filter, + $det_id1, $iter1, $det_id2, $iter2, $operation, $mask, + $workdir, $dbname, $no_update); +GetOptions( + 'det_type=s' => \$det_type, # Detrend type for new detrend + 'filelevel=s' => \$filelevel, # File level for new detrend + 'inst=s' => \$inst, # Instrument for new detrend + 'telescope=s' => \$telescope, # Telescope for new detrend + 'filter=s' => \$filter, # Filter name for new detrend + 'det_id1=s' => \$det_id1, # Detrend id for detrend 1 + 'iteration1=s' => \$iter1, # Iteration for detrend 1 + 'det_id2=s' => \$det_id2, # Detrend id for detrend 2 + 'iteration2=s' => \$iter2, # Iteration for detrend 2 + 'operation=s' => \$operation, # Operation to perform on files + 'mask' => \$mask, # Operation is on a mask + 'workdir=s' => \$workdir, # Working directory for output files + 'dbname=s' => \$dbname, # Database name + 'no-update' => \$no_update, # Don't update the database + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options --det_type --filelevel --inst --telescope --det_id1 --iteration1 --det_id2 --iteration2 --workdir", + -exitval => 3, + ) + unless defined $det_type + and defined $filelevel + and defined $inst + and defined $telescope + and defined $det_id1 + and defined $iter1 + and defined $det_id2 + and defined $iter2 + and defined $operation + and defined $workdir; + +$ipprc->define_camera($inst); + +my $STATS = + [ + # PPSTATS KEYWORD STATISTIC CHIPTOOL FLAG + { name => "ROBUST_MEDIAN", type => "mean", flag => "-bg", dtype => "float" }, + { name => "ROBUST_MEDIAN", type => "stdev", flag => "-bg_mean_stdev", dtype => "float" }, + { name => "ROBUST_STDEV", type => "rms", flag => "-bg_stdev", dtype => "float" }, + ]; + +# Look for programs we need +my $missing_tools; +my $detselect = can_run('detselect') or (warn "Can't find detselect" and $missing_tools = 1); +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppArith = can_run('ppArith') or (warn "Can't find ppArith" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Get the list of inputs +my $files1 = filelist($det_id1, $iter1); # Hash of input files for detrend 1 +my $files2 = filelist($det_id2, $iter2); # Hash of input files for detrend 2 +die("File lists for detrends have differing lengths") unless scalar keys %$files1 == scalar keys %$files2; + +my ($det_id, $iter); # Detrend identifier for the new detrend +unless ($no_update) { + my $command = "$dettool -register_detrend -det_type $det_type -filelevel $filelevel -workdir $workdir " . + "-inst $inst -telescope $telescope"; # Command to run + $command .= " -filter $filter" if defined $filter; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 1); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + die("Unable to run dettool -register_detrend: $error_code"); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or die("Unable to parse metadata config doc\n"); + my $md = parse_md_list($metadata) or die("Unable to parse metadata list\n"); + + $det_id = $$md[0]->{det_id}; + $iter = $$md[0]->{iteration}; + + die("Unable to get det_id and iteration for new detrend.\n") unless defined $det_id and defined $iter; +} else { + $det_id = 'DUMMY_DET_ID'; + $iter = 'DUMMY_ITER'; +} + +my $outRoot = caturi($workdir, "$inst.$det_id.$iter"); # Output root name +my $filerule = (defined $mask ? "PPARITH.OUTPUT.MASK" : "PPARITH.OUTPUT.IMAGE"); # File rule for ppArith + +foreach my $class_id ( keys %$files1 ) { + my $md1 = $$files1{$class_id}; + my $md2 = $$files2{$class_id}; + die("Class_id=$class_id not defined for det_id=$det_id2") unless defined $md2; + + my $uri1 = $$md1[0]->{uri}; + my $uri2 = $$md2[0]->{uri}; + + die("Unable to find input file $uri1\n") unless $ipprc->file_exists($uri1); + die("Unable to find input file $uri2\n") unless $ipprc->file_exists($uri2); + + my $outName = $ipprc->filename($filerule, $outRoot, $class_id); + my $outStats = $outRoot . '.stats'; + + my $command = "$ppArith -file1 $uri1 -op \'$operation\' -file2 $uri2 $outRoot"; # Command to run + $command .= " -stats $outStats -recipe PPSTATS $RECIPE_PPSTATS"; + $command .= ' -mask' if defined $mask; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 1); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + die("Unable to run ppArith: $error_code"); + } + + die("Unable to find ppArith product: $outName\n") unless $ipprc->file_exists($outName); + die("Unable to find ppArith product: $outStats\n") unless $ipprc->file_exists($outStats); + + # Get the statistics on the processed image + my $stats = PS::IPP::Metadata::Stats->new($STATS); # Stats parser + { + my $statsFile; # File handle + open $statsFile, $ipprc->file_resolve($outStats) or die("Can't open stats file $outStats: $!"); + my @contents = <$statsFile>; # Contents of file + close $statsFile; + + my $metadata = $mdcParser->parse(join "", @contents) or die("Unable to parse metadata config doc"); + + unless ($stats->parse($metadata)) { + &my_die("Failure extracting metadata from the statistics output file.\n"); + } + } + + # Register the imfile + unless ($no_update) { + my $command = "$dettool -register_detrend_imfile -det_id $det_id "; # Command to run + $command .= " -class_id $class_id -uri $outName -path_base $outRoot"; + $command .= $stats->cmdflags(); + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 1); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + die("Unable to run dettool -register_detrend_imfile: $error_code"); + } + } +} + + +### Pau. + + +# Get a list of files for the given detrend +sub filelist +{ + my $det_id = shift; # Detrend identifier + my $iter = shift; # Iteration + + my $command = "$detselect -select -det_id $det_id -iteration $iter"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 1); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + die("Unable to run detselect: $error_code"); + } + + # Because of the length, need to split into individual metadatas --- it parses SO much quicker! + my %files; + + my $md = $mdcParser->parse( join( "", @$stdout_buf ) ); # Parsed metadata + my $list = parse_md_list( $md ); + + foreach my $item ( @$list ) { + my $class_id = $item->{class_id}; + die("Multiple definitions of class_id=$class_id found for det_id=$det_id, iteration=$iter\n") if + defined $files{$class_id}; + $files{$class_id} = parse_md_list($md); + } + + return \%files; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_filename.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_filename.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_filename.pl (revision 41105) @@ -0,0 +1,68 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# use these to check the apache environment +#print "$ENV{'PATH'}\n"; +#print "$ENV{'PERL5LIB'}\n"; +#print "NEB_SERVER: $ENV{'NEB_SERVER'}
\n"; + +# EAM: check for missing NEB_SERVER and exit with an error +unless (defined($ENV{'NEB_SERVER'})) { + print "NEB_SERVER not defined in ipp_filename.pl\n"; + exit (5); +} +if ($ENV{'NEB_SERVER'} eq "") { + print "NEB_SERVER not set in ipp_filename.pl\n"; + exit (6); +} + +use PS::IPP::Config; +my $ipprc = PS::IPP::Config->new(); + +my ($filerule, $class_id, $basename, $camera, $touch); + +GetOptions('filerule=s' => \$filerule, + 'class_id=s' => \$class_id, + 'basename=s' => \$basename, + 'camera|c=s' => \$camera, + 'touch' => \$touch, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --filerule --class_id --basename --camera", + -exitval => 3, +) unless defined $basename + and defined $filerule + and defined $class_id + and defined $camera; + +$touch = 0 unless (defined $touch); + +$ipprc->define_camera($camera); + +# print "$filerule\n"; +# print "$basename\n"; +# print "$camera\n"; +# print "$class_id\n"; + +my $filename = $ipprc->filename($filerule, $basename, $class_id); +# print "$filename\n"; +# print "touch: $touch\n"; + +my $realname = $ipprc->file_resolve( $filename, $touch ); +if (not defined $realname) { + print "nebulous file $filename not found\n"; + exit (1); +} + +print "$realname\n"; + +1; + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_image_path.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_image_path.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_image_path.pl (revision 41105) @@ -0,0 +1,201 @@ +#!/usr/bin/env perl + +# ipp_image_path.pl print out the unix path name(s) for rawImage files for an exposure +# + +use warnings; +use strict; + +# get images that are on ipp008 from alternative location until the +# database is updated +my $use_008_workaround = 0; +my $use_017_workaround = 0; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use DBI; +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); +use Nebulous::Client; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($exp_name, $class_id, $from_registered, $dbname, $verbose, $alternate); + +GetOptions( + 'exp_name|e=s' => \$exp_name, + 'class_id|c=s' => \$class_id, + 'registered|r' => \$from_registered, + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'alternate' => \$alternate, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --exp_name", + -exitval => 3) unless + defined $exp_name; + +my $ota_num; +if ($class_id) { + $class_id = lc($class_id); + my $extra; + (undef, $ota_num, $extra) = $class_id =~ m/(\D*)(\d\d)(.*)/; + if ($extra || !$ota_num) { + print STDERR "$class_id is not a valid class_id\n"; + exit 1; + } +} + +# Look for commands we need +my $missing_tools; +my $neb_locate = can_run('neb-locate') + or (warn "can't find neb-locate" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $ipprc = PS::IPP::Config->new(); +my $dbh = getDBHandle(); + +# Get the list of imfiles +{ + # XXX: If there are multiple exposures with the same exposure name + # this query will return them all + my $query; + if ($from_registered) { + $query = "SELECT exp_id, class_id, uri FROM rawImfile" + . " WHERE exp_name = \'$exp_name\'"; + $query .= " AND class_id = \'xy$ota_num\'" if ($ota_num); + } else { + $query = "SELECT exp_id FROM newExp WHERE tmp_exp_name = ?"; + my $stmt = $dbh->prepare($query); + $stmt->execute($exp_name); + my $exp_ref = $stmt->fetchrow_hashref(); + if (!$exp_ref) { + print STDERR "exposure $exp_name not found\n"; + exit 1; + } + $stmt->finish(); + $query = "SELECT exp_id, tmp_class_id, uri FROM newImfile WHERE exp_id = $exp_ref->{exp_id}"; + $query .= " AND tmp_class_id = \'ota$ota_num\'" if ($ota_num); + } + + my $stmt = $dbh->prepare($query); + $stmt->execute(); + my $nfiles = 0; + while (my $ref = $stmt->fetchrow_hashref()) { + my $uri = $ref->{uri}; + my $path; + my ($scheme) = $uri =~/^(path|neb|file):/; + + if (!$scheme) { + $path = $uri; + } else { + if ($use_008_workaround && ($uri =~ /ipp008/)) { + $path = resolve_ipp008_file($uri); + } elsif ($use_017_workaround && ($uri =~ /4683/) && + ($uri =~ /ipp017/)) { + $path = resolve_ipp017_file($uri); + } elsif ($alternate) { + my $neb = $ipprc->nebulous(); + my $uris = $neb->find_instances($uri,'any'); + my @files = map {URI->new($_)->file if $_} @$uris; + + if ($#files > 0) { + $path = $files[1]; + } + else { + $path = $files[0]; + } + + } + else { + $path = $ipprc->file_resolve($uri); + } + } + if ($path) { + # remove the leading "file://" if present + $path =~ s/^file\:\/\///; + $nfiles++; + print "$path\n"; + } + } + if (!$nfiles) { + my $cstr = defined($class_id) ? $class_id . " " : ""; + print STDERR "exposure $exp_name " . $cstr . "not found\n"; + exit 2; + } +} + +sub getDBHandle { + my $dbserver = metadataLookupStr($ipprc->{_siteConfig}, "DBSERVER"); + my $dbuser = metadataLookupStr($ipprc->{_siteConfig}, "DBUSER"); + my $dbpassword = metadataLookupStr($ipprc->{_siteConfig}, "DBPASSWORD"); + if (!$dbname) { + $dbname = metadataLookupStr($ipprc->{_siteConfig}, "DBNAME"); + } + + die "database configuration set up" unless defined($dbserver) and defined($dbuser) + and defined($dbpassword) and defined($dbname); + + my $dsn = "DBI:mysql:host=$dbserver;database=$dbname"; + + my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) + or die "Cannot connect to database.\n"; + + return $dbh; +} + +sub resolve_ipp008_file { + my %locations = ( "ota24" => "ipp006", + "ota25" => "ipp009", + "ota26" => "ipp011", + "ota27" => "ipp019", + "ota30" => "ipp020", + "ota31" => "ipp021" + ); + + my $uri = shift; + + # uri's look like neb://ipp008.0/gpc1/20080625/o4642g0400o/o4642g0400o.ota24.fits + + my ($left, $middle, $ota, $fits) = split '\.', $uri; + + my $node = $locations{$ota}; + + die "can't find node for $ota: $uri" if (!$node); + + my $path = $uri; + + $path =~ s%neb://ipp008.0%/data/${node}.0/recover08%; + + die "sorry backup image for $uri not found\n" if (!-e $path); + + return $path; +} + +sub resolve_ipp017_file { + my $uri = shift; + + # uri's look like neb://ipp008.0/gpc1/20080625/o4642g0400o/o4642g0400o.ota24.fits + + my ($left, $middle, $ota, $fits) = split '\.', $uri; + + my $node = "ipp015"; + + die "can't find node for $ota: $uri" if (!$node); + + my $path = $uri; + + $path =~ s%neb://ipp017.0%/data/${node}.0/recover17%; + + die "sorry backup image for $uri not found\n" if (!-e $path); + + return $path; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_inject_expname.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_inject_expname.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_inject_expname.pl (revision 41105) @@ -0,0 +1,190 @@ +#!/usr/bin/env perl + +# this program injects a set of files the db, assuming the list of +# files all belong to a single exposure the user supplies a temporary +# telescope and camera name. these are used for informational +# purposes only until the registration step can determine the true +# telescope and camera name from the image headers. + +# this program should not fail because of the data format or the +# configuration, except for the very basic database setup. + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use PS::IPP::Config 1.01 qw( :standard ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +my $ipprc = PS::IPP::Config->new(); # this is used for PATH, NEB filename conversions + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($camera, $telescope, $workdir, $reduction, $dvo_db, $tess_id, $end_stage, $label, $from_db, $dbname, $no_op, $verbose, $help); +GetOptions('camera|i=s' => \$camera, # user-supplied camera name + 'telescope|t=s' => \$telescope, # user-supplied telescope name + 'workdir|w=s' => \$workdir, # working directory for output files + 'reduction=s' => \$reduction, # user-supplied camera name + 'dvodb=s' => \$dvo_db, # target dvo database + 'tess_id=s' => \$tess_id, # tessalation for warping + 'end_stage=s' => \$end_stage, # stop processing at this step + 'label=s' => \$label, # set chip label + 'from=s' => \$from_db, # Source Database name + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-op' => \$no_op, # pretend but don't actually inject + 'help' => \$help # give help listing + ) or pod2usage( 2 ); + +pod2usage( -msg => "inject files based on query to another IPP db", + -exitval => 2) if + defined $help; + +pod2usage( -msg => "Usage: $0 [--from dbname] [--workdir path] [--reduction class] [--dvodb db] [--tess_id tess] [--end_stage stage] [--label label] [--dbname dbname] (exp_name)", + -exitval => 2 ) if + scalar @ARGV == 0; + +pod2usage( + -msg => "Required options: --exp_tag --cam_id --camera --outroot", + -exitval => 3, + ) unless + defined $from_db; + +my $exp_name = $ARGV[0]; + +my $pxinject = can_run('pxinject') or die "Can't find pxinject\n"; +my $regtool = can_run('regtool') or die "Can't find regtool\n"; + +# tess_id needs to be an absolute path, or it must start with file://, path://, or neb:// +if ($tess_id) { + $tess_id = &fixpath ($tess_id); +} + +# dvodb needs to be an absolute path, or it must start with file://, path://, or neb:// +if ($dvo_db) { + $dvo_db = &fixpath ($dvo_db); +} + +# workdir needs to be an absolute path, or it must start with file://, path://, or neb:// +if ($workdir) { + $workdir = &fixpath ($workdir); +} + +# if workdir is not defined, assign the current path +if (! $workdir) { + $workdir = File::Spec->rel2abs( "." ); +} + +if (! $telescope) { + $telescope = "UNKNOWN"; +} + +if (! $camera) { + $camera = "UNKNOWN"; +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# query the from_db for the desired imfiles: +# regtool -dbname $from_db -processedimfile -exp_name $exp_name + +# Get list of component files +my $files; # Array of component files +{ + my $command = "$regtool -dbname $from_db -processedimfile -exp_name $exp_name"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + die "Unable to perform regtool for $exp_name: $error_code"; + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + die "Unable to parse metadata config doc $exp_name: $error_code"; + + # extract the metadata for the files into a hash list + $files = parse_md_list($metadata) or + die "Unable to parse metadata list: $exp_name: $error_code"; +} + +## inject the exposure + +# the telescope, instrument, and exp_name used here are temporary : register replaces them with the true values +my $command_exp = "$pxinject -newExp"; +$command_exp .= " -tmp_exp_name $exp_name"; +$command_exp .= " -tmp_inst $camera"; +$command_exp .= " -tmp_telescope $telescope"; +$command_exp .= " -workdir $workdir"; +$command_exp .= " -reduction $reduction" if defined $reduction; +$command_exp .= " -dvodb $dvo_db" if defined $dvo_db; +$command_exp .= " -tess_id $tess_id" if defined $tess_id; +$command_exp .= " -end_stage $end_stage" if defined $end_stage; +$command_exp .= " -label $label" if defined $label; +$command_exp .= " -dbname $dbname" if defined $dbname; + +my $exp_id = 0; +unless ($no_op) { + my ( $success_exp, $error_code_exp, $full_buf_exp, $stdout_buf_exp, $stderr_buf_exp ) = + run( command => $command_exp, verbose => 1 ); + die "Unable to inject $exp_name: $error_code_exp\n" if not $success_exp; + + my @line = split(/\s+/, $$stdout_buf_exp[0]); # The output line, containing the exposure tag + $exp_id = $line[2]; # The exposure tag +} else { + print "skipping command: $command_exp\n"; +} + +# now inject the imfiles one at a time +foreach my $file (@$files) { + + my $uri = $file->{uri}; + my $class_id = $file->{class_id}; + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_imfile = "$pxinject -newImfile"; + $command_imfile .= " -exp_id $exp_id"; + $command_imfile .= " -tmp_class_id $class_id"; + $command_imfile .= " -uri $uri"; + $command_imfile .= " -dbname $dbname" if defined ($dbname); + + unless ($no_op) { + my ( $success_imfile, $error_code_imfile, $full_buf_imfile, $stdout_buf_imfile, $stderr_buf_imfile ) = run( command => $command_imfile, verbose => 1 ); + die "Unable to inject $exp_name imfile: $error_code_imfile\n" if not $success_imfile; + } else { + print "skipping command: $command_imfile\n"; + } +} + +# the class_id used here is temporary : register replaces it with the true class_id +my $command_update = "$pxinject -updatenewExp"; +$command_update .= " -exp_id $exp_id"; +$command_update .= " -state run"; +$command_update .= " -dbname $dbname" if defined ($dbname); + +unless ($no_op) { + my ( $success_update, $error_code_update, $full_buf_update, $stdout_buf_update, $stderr_buf_update ) = run( command => $command_update, verbose => 1 ); + die "Unable to update $exp_name: $error_code_update\n" if not $success_update; +} else { + print "skipping command: $command_update\n"; +} + +exit 0; + +sub fixpath { + my $path = shift; + my $valid = 0; + $valid |= ($path =~ m|^file://|); + $valid |= ($path =~ m|^path://|); + $valid |= ($path =~ m|^neb://|); + $valid |= ($path =~ m|^/|); + + if (!$valid) { + $path = File::Spec->rel2abs( $path ); + } + return $path; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_inject_fileset.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_inject_fileset.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_inject_fileset.pl (revision 41105) @@ -0,0 +1,185 @@ +#!/usr/bin/env perl + +# this program injects a set of files the db, assuming the list of +# files all belong to a single exposure the user supplies a temporary +# telescope and camera name. these are used for informational +# purposes only until the registration step can determine the true +# telescope and camera name from the image headers. + +# this program should not fail because of the data format or the +# configuration, except for the very basic database setup. + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use PS::IPP::Config qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # this is used for PATH, NEB filename conversions + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($camera, $telescope, $workdir, $reduction, $dvo_db, $tess_id, $end_stage, $label, $dbname, $no_op, $help); +my $exp_name; +GetOptions('camera|i=s' => \$camera, # user-supplied camera name + 'telescope|t=s' => \$telescope, # user-supplied telescope name + 'exp_name|=s' => \$exp_name, # user-supplied exp_name name + 'workdir|w=s' => \$workdir, # working directory for output files + 'reduction=s' => \$reduction, # user-supplied camera name + 'dvodb=s' => \$dvo_db, # target dvo database + 'tess_id=s' => \$tess_id, # tessalation for warping + 'end_stage=s' => \$end_stage, # stop processing at this step + 'label=s' => \$label, # set chip label + 'dbname|d=s' => \$dbname, # Database name + 'no-op' => \$no_op, # pretend but don't actually inject + 'help' => \$help # give help listing + ) or pod2usage( 2 ); + +pod2usage( -msg => "inject one or many files into the IPP pipeline database", + -exitval => 2) if + defined $help; + +pod2usage( -msg => "Usage: $0 --telescope (name) --camera (name) [--workdir path] [--reduction class] [--dvodb db] [--tess_id tess] [--end_stage stage] [--label label] [--dbname dbname] (files)", + -exitval => 2 ) if + scalar @ARGV == 0; + +# XXX why are these required? +pod2usage( -msg => "Required options: --telescope (name) --camera (name)", + -exitval => 3) unless @ARGV > 0; + +my $pxinject = can_run('pxinject') or die "Can't find pxinject\n"; + +# tess_id needs to be an absolute path, or it must start with file://, path://, or neb:// +if ($tess_id) { + $tess_id = &fixpath ($tess_id); +} + +# dvodb needs to be an absolute path, or it must start with file://, path://, or neb:// +if ($dvo_db) { + $dvo_db = &fixpath ($dvo_db); +} + +# workdir needs to be an absolute path, or it must start with file://, path://, or neb:// +if ($workdir) { + $workdir = &fixpath ($workdir); +} + +# if workdir is not defined, assign the current path +if (! $workdir) { + $workdir = File::Spec->rel2abs( "." ); +} + +if (! $telescope) { + $telescope = "UNKNOWN"; +} + +if (! $camera) { + $camera = "UNKNOWN"; +} + +# if not supplied, use the first file name as the exp_name (strip off .fits) +my $num = 0; +foreach my $file ( @ARGV ) { + # check for file existence + my $resolved = $ipprc->file_resolve($file); + if (!$resolved or ! -e $resolved) { die "file $file not found\n"; } + if (! $exp_name) { + # strip off the extension + my ( $vol, $path, $name ) = File::Spec->splitpath( $file ); + ( $exp_name ) = $name =~ /(.*)\.(fits|fit|fts|flt)(|.gz)/; + print "exp_name : $exp_name.\n"; + } + $num ++; +} + +print "$num files in fileset.\n"; + +## inject the exposure + +# the telescope, instrument, and exp_name used here are temporary : register replaces them with the true values +my $command_exp = "$pxinject -newExp"; +$command_exp .= " -tmp_exp_name $exp_name"; +$command_exp .= " -tmp_inst $camera"; +$command_exp .= " -tmp_telescope $telescope"; +$command_exp .= " -workdir $workdir"; +$command_exp .= " -reduction $reduction" if defined $reduction; +$command_exp .= " -dvodb $dvo_db" if defined $dvo_db; +$command_exp .= " -tess_id $tess_id" if defined $tess_id; +$command_exp .= " -end_stage $end_stage" if defined $end_stage; +$command_exp .= " -label $label" if defined $label; +$command_exp .= " -dbname $dbname" if defined $dbname; + +my $exp_id = 0; +unless ($no_op) { + my ( $success_exp, $error_code_exp, $full_buf_exp, $stdout_buf_exp, $stderr_buf_exp ) = + run( command => $command_exp, verbose => 1 ); + die "Unable to inject $exp_name: $error_code_exp\n" if not $success_exp; + + my @line = split(/\s+/, $$stdout_buf_exp[0]); # The output line, containing the exposure tag + $exp_id = $line[2]; # The exposure tag +} else { + print "skipping command: $command_exp\n"; +} + +# now inject the imfiles one at a time +for (my $i = 0; $i < @ARGV; $i++) { + + my $file = $ARGV[$i]; + + my $relfile; + my $scheme = file_scheme($file); + if (!$scheme or $scheme ne 'neb') { + my $absfile = File::Spec->rel2abs( $file ); + $relfile = $ipprc->convert_filename_relative( $absfile ); + } else { + $relfile = $file; + } + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_imfile = "$pxinject -newImfile"; + $command_imfile .= " -exp_id $exp_id"; + $command_imfile .= " -tmp_class_id file.$i"; + $command_imfile .= " -uri $relfile"; + $command_imfile .= " -dbname $dbname" if defined ($dbname); + + unless ($no_op) { + my ( $success_imfile, $error_code_imfile, $full_buf_imfile, $stdout_buf_imfile, $stderr_buf_imfile ) = run( command => $command_imfile, verbose => 1 ); + die "Unable to inject $exp_name imfile: $error_code_imfile\n" if not $success_imfile; + } else { + print "skipping command: $command_imfile\n"; + } +} + +# the class_id used here is temporary : register replaces it with the true class_id +my $command_update = "$pxinject -updatenewExp"; +$command_update .= " -exp_id $exp_id"; +$command_update .= " -state run"; +$command_update .= " -dbname $dbname" if defined ($dbname); + +unless ($no_op) { + my ( $success_update, $error_code_update, $full_buf_update, $stdout_buf_update, $stderr_buf_update ) = run( command => $command_update, verbose => 1 ); + die "Unable to update $exp_name: $error_code_update\n" if not $success_update; +} else { + print "skipping command: $command_update\n"; +} + +exit 0; + +sub fixpath { + my $path = shift; + my $valid = 0; + $valid |= ($path =~ m|^file://|); + $valid |= ($path =~ m|^path://|); + $valid |= ($path =~ m|^neb://|); + $valid |= ($path =~ m|^/|); + + if (!$valid) { + $path = File::Spec->rel2abs( $path ); + } + return $path; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_maskscript.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_maskscript.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_maskscript.pl (revision 41105) @@ -0,0 +1,187 @@ +#!/usr/bin/env perl + +# use warnings; +# use strict; +use Carp; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use IPC::Cmd 0.36 qw( can_run run ); +use IO::Handle; + +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +my ($dbname, $det_id, $camera); +GetOptions('dbname=s' => \$dbname, + 'det_id=s' => \$det_id, + 'camera|c=s' => \$camera, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "USAGE: ipp_maskscript.pl --dbname (name) --det_id (id) --iter (iteration) --camera (name)", + -exitval => 3, + ) unless defined $dbname and defined $det_id and defined $camera; + +# I could determine the camera from a query for the detrun +my $ipprc = PS::IPP::Config->new( $camera ) or my_die("Unable to setup", $PS_EXIT_CONFIG_ERROR); # IPP configuration + +### Get list of dark imfile results + +# define the dettool command +my $command = "dettool -processedimfile -select_state stop"; # Command to run +$command .= " -det_id $det_id"; +$command .= " -dbname $dbname" if defined $dbname; + +# run the dettool command and catch the output +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", $error_code); +} + +# parse the output into a list +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $PS_EXIT_PROG_ERROR); +my $list = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $PS_EXIT_PROG_ERROR); + +my @bg_data; +my @bg_stdev_data; +my @bg_name; +my @bg_exptime; +my %components; + +print STDERR "extracted the data from the database\n"; + +# we now have a list of imfiles; we need to extract the background for each cell +# from the stats files for each imfile +foreach my $item (@$list) { + my $path_base = $item->{path_base}; + my $class_id = $item->{class_id}; + my $exp_time = $item->{exp_time}; + + my $rootName = $ipprc->file_resolve ($path_base); + my $statsName = "$rootName.$class_id.stats"; + + # print STDERR "rootName: $rootName : $exp_time\n"; + print STDERR "statsName: $statsName : $exp_time\n"; + + my $statsFile; + open $statsFile, $statsName; + my @contents = <$statsFile>; + close ($statsFile); + + # print STDERR "contents: @contents\n"; + + my $parser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $statsList = $parser->parse(join "", @contents) or &my_die("Unable to parse metadata for imfile stats", $PS_EXIT_SYS_ERROR); + + &parse_stats_table ($exp_time, $class_id, $statsList); +} + +print STDERR "parsed the stats from the data files\n"; + +for (my $i = 0; $i < @bg_data; $i++) { + $nameX = "$bg_name[$i].exp"; + $nameY = "$bg_name[$i].bg"; + push @{$nameX}, $bg_exptime[$i]; + push @{$nameY}, $bg_data[$i]; +} + +if (-e "output.dat") { unlink "output.dat"; } + +print STDERR "dumping stats\n"; +open (MANA, "|mana --norc"); +MANA->autoflush; + +foreach my $component (@components) { + $nameX = "$component.exp"; + $nameY = "$component.bg"; + + print MANA "delete X Y\n"; + + open (DATA, ">$component.dat"); + for (my $i = 0; $i < @{$nameX}; $i++) { + print DATA "${$nameX}[$i] ${$nameY}[$i]\n"; + } + close (DATA); + + print MANA "data $component.dat\n"; + print MANA "read X 1 Y 2\n"; + print MANA "fit X Y 2 -clip 3 3\n"; + print MANA "output output.dat\n"; + print MANA "echo $component METADATA\n"; + print MANA "echo \" NORDER_X S32 2 \"\n"; + print MANA "echo \" VAL_X00 F64 \$C0\"\n"; + print MANA "echo \" VAL_X01 F64 \$C1\"\n"; + print MANA "echo \" VAL_X02 F64 \$C2\"\n"; + print MANA "echo \" NELEMENTS S32 3 \"\n"; + print MANA "echo END\n"; + print MANA "echo\n"; + print MANA "output stdout\n"; + + print MANA "applyfit X Yf\n"; + print MANA "lim X Y\n"; + print MANA "clear\n"; + print MANA "box\n"; + print MANA "plot -x 2 -pt 2 -sz 1.0 -c black X Y\n"; + print MANA "plot -x 2 -pt 7 -sz 1.0 -c red X Yf\n"; + + print STDERR "hit return to continue\n"; + $answer = ; +} + +close (MANA); + +exit 0; + +sub parse_stats_table +{ + my ($exp_time, $tag, $md) = @_; + + # descend through the fpa + foreach my $entry (@$md) { + # print STDERR "name: $entry->{name}, class: $entry->{class}\n"; + # recurse on nested metadata + if ($entry->{class} eq 'metadata') { + my $newtag = $tag . "_" . $entry->{name}; + &parse_stats_table ($exp_time, $newtag, $entry->{value}); + } + + if ($entry->{name} =~ /^(SAMPLE|ROBUST|FITTED|CLIPPED)/) { + # It's a statistic of some sort + if ($entry->{name} =~ /_STDEV$/) { + push @bg_stdev_data, $entry->{value}; + } else { + push @bg_name, $tag; + push @bg_data, $entry->{value}; + push @bg_exptime, $exp_time; + # print STDERR "$tag $exp_time $entry->{value}\n"; + } + if (!$componentsHash{$tag}) { + push @components, $tag; + $componentsHash{$tag} = 1; + } + next; + } + } + return 1; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $exit_code = shift; # Exit code to add + + carp($msg); + exit $exit_code; +} + +# - get the exp_time as well from dettool +# - build an array of bg & exptime for each cell +# - fit the trend (in mana? pslib functions?) +# - write the polynomial for each cell Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_mops_translate.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_mops_translate.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_mops_translate.pl (revision 41105) @@ -0,0 +1,245 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use Astro::FITS::CFITSIO qw( :constants ); +Astro::FITS::CFITSIO::PerlyUnpacking(1); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use Math::Trig; +use Data::Dumper; +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); + +use constant EXTNAME => 'MOPS_TRANSIENT_DETECTIONS'; # Extension name for output table +use constant ZERO_POINT => 25; # Magnitude zero point +use constant OBSERVATORY_CODE => 566; # IAU Observatory Code +use constant FAKE_LIMITING_MAG => 23.0; # Fake limiting magnitude to report +use constant FAKE_DETECTION_EFFICIENCY => 0.0; # Fake detection efficiency to report + +my ( $input, # Name of input file with IPP photometry + $extname, # Name of extension containing photometry + $skycell, # Skycell file with WCS + $output, # Name of output file + $save_temps, # Save temporary files? + ); + +GetOptions( + 'input=s' => \$input, + 'extname=s' => \$extname, + 'output=s' => \$output, + 'save-temps' => \$save_temps, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --input --extname --output", + -exitval => 3) + unless defined $input + and defined $extname + and defined $output; + +# Specification of columns to write +my $columns = [ { name => 'RA_DEG', type => 'D' }, # Right ascension + { name => 'RA_SIG', type => 'D' }, # Error in right ascension + { name => 'DEC_DEG', type => 'D' }, # Declination + { name => 'DEC_SIG', type => 'D' }, # Error in declination + { name => 'FLUX', type => 'D' }, # Flux + { name => 'FLUX_SIG', type => 'D' }, # Error in flux + { name => 'STARPSF', type => 'D' }, # probability that the PSF matches a starlike PSF + { name => 'ANG', type => 'D' }, # Angle + { name => 'ANG_SIG', type => 'D' }, # Error in angle + { name => 'LEN', type => 'D' }, # Length + { name => 'LEN_SIG', type => 'D' }, # Error in length + ]; + +# Header translation table +my $headers = { + # IPP name => MOPS name, type, comment + 'FPA.RA' => { name => 'RA', type => TSTRING, comment => 'Right ascension of boresight'}, + 'FPA.DEC' => { name => 'DEC', type => TSTRING, comment => 'Declination of boresight' }, + 'FPA.FILTER' => { name => 'FILTER', type => TSTRING, comment => 'Filter name' }, + 'EXPTIME' => { name => 'EXPTIME', type => TDOUBLE, comment => 'Exposure time' }, + 'FPA.POSANGLE' => { name => 'ROTANGLE', type => TDOUBLE, comment => 'Position angle' }, + 'FPA.ALT' => { name => 'TEL_ALT', type => TDOUBLE, comment => 'Telescope altitude' }, + 'FPA.AZ' => { name => 'TEL_AZ', type => TDOUBLE, comment => 'Telescope azimuth' }, + 'IMAGEID' => { name => 'DIFFIMID', type => TINT, comment => 'Difference image identifier'}, + 'FPA.OBS' => { name => 'FPA_ID', type => TSTRING, comment => 'Exposure identifier' }, +}; + + +# Read header +my $inputResolved = $ipprc->file_resolve($input); # Resolved filename +my $status = 0; # CFITSIO status +my $inFits = Astro::FITS::CFITSIO::open_file( $inputResolved, READONLY, $status ); # FITS file handle +die("failed to open input file: $inputResolved: $status") if $status; +my $inHeader = $inFits->read_header(); # Header for input +check_fitsio($status); + +# Read table data +$inFits->movnam_hdu(BINARY_TBL, $extname, 0, $status) and check_fitsio($status); +my $numRows; # Number of rows in table +$inFits->get_num_rows($numRows, $status) and check_fitsio($status); + +my $ra = column($inFits, 'RA_PSF', $numRows); # Right Ascension, degrees +my $dec = column($inFits, 'DEC_PSF', $numRows); # Declination, degrees +my $mag = column($inFits, 'PSF_INST_MAG', $numRows); # Magnitude +my $magErr = column($inFits, 'PSF_INST_MAG_SIG', $numRows); # Magnitude error +my $ens = column($inFits, 'EXT_NSIGMA', $numRows); # Significance of extension +my $xErr = column($inFits, 'X_PSF_SIG', $numRows); # Error in x position, pixels +my $yErr = column($inFits, 'Y_PSF_SIG', $numRows); # Error in y position, pixels +my $scale = column($inFits, 'PLTSCALE', $numRows); # Plate scale, arcsec/pixel +my $angle = column($inFits, 'POSANGLE', $numRows); # Position angle, degrees + +$inFits->close_file( $status ); + +my ($raErr, $decErr); # Error in ra, dec +for (my $i = 0; $i < $numRows; $i++) { + my $cosPA = cos($$angle[$i]); + my $sinPA = sin($$angle[$i]); + + # XXX Not sure about the transformation here --- check + $$raErr[$i] = $$scale[$i] * ($cosPA * $xErr + $sinPA * $yErr) / 3600; + $$decErr[$i] = $$scale[$i] * ($sinPA * $xErr - $cosPA * $yErr) / 3600; +} + +# Plate scales +#my $cdelt1 = $$inHeader{'CDELT1'} or die("Can't find CDELT1"); +#my $cdelt2 = $$inHeader{'CDELT2'} or die("Can't find CDELT2"); +### XXX WCS wasn't being set in inverse diffs, but it's available elsewhere +my $cdelt1 = $$scale[0] / 3600; +my $cdelt2 = $$scale[1] / 3600; + +# Parse the list of columns +my @colNames; # Names of columns +my @colTypes; # Types of columns +my %colData; # Data for each column +foreach my $colSpec ( @$columns) { + push @colNames, $colSpec->{name}; + push @colTypes, $colSpec->{type}; + $colData{$colSpec->{name}} = []; +} + + +# Convert the input data into the output formats +for (my $i = 0; $i < $numRows; $i++) { + push @{$colData{'RA_DEG'}}, $ra; + push @{$colData{'DEC_DEG'}}, $dec; + push @{$colData{'RA_SIG'}}, $raErr; + push @{$colData{'DEC_SIG'}}, $decErr; + push @{$colData{'FLUX'}}, $$mag[$i] + ZERO_POINT; + push @{$colData{'FLUX_SIG'}}, $magErr; + push @{$colData{'ANG'}}, 0.0; + push @{$colData{'ANG_SIG'}}, 0.0; + push @{$colData{'LEN'}}, 0.0; + push @{$colData{'LEN_SIG'}}, 0.0; + push @{$colData{'STARPSF'}}, $$ens[$i]; # for now set this to the value of EXT_NSIGMA +} + + +# Write the output +my $outputResolved = $ipprc->file_resolve($output, 1); +unlink "$outputResolved"; +my $outFits = Astro::FITS::CFITSIO::create_file( $outputResolved, $status ); # Output file handle +check_fitsio( $status ); + +# Write the table +$outFits->create_tbl( BINARY_TBL(), $numRows, scalar @colNames, \@colNames, \@colTypes, undef, EXTNAME, + $status ); +check_fitsio( $status ); + +# Write the header keywords +foreach my $keyword ( keys %$headers ) { + my $value = $inHeader->{$keyword}; # Header keyword value + unless (defined $value) { + print "Can't find header keyword $keyword\n"; + next; + } + $value =~ s/\'//g; + my $name = $headers->{$keyword}->{name}; # New name + my $type = $headers->{$keyword}->{type}; # Type + my $comment = $headers->{$keyword}->{comment}; # Comment + $outFits->write_key( $type, $name, $value, $comment, $status ); + check_fitsio( $status ); +} + +# Adjust the time from start to mid-point +{ + my $mjd = $inHeader->{'MJD-OBS'} or die "Can't find MJD.\n"; # Modified Julian Date + my $exptime = $inHeader->{'EXPTIME'} or die "Can't find EXPTIME.\n"; # Exposure time, seconds + $mjd += $exptime / 2.0 / 3600 / 24; # start --> mid-point + $outFits->write_key( TDOUBLE, 'MJD-OBS', $mjd, 'Time of exposure mid-point', $status); + check_fitsio( $status ); +} + +# Stellar PSF +my $fwhm = 0.5 * 3600 * ($inHeader->{'FWHM_MAJ'} * $cdelt1 + $inHeader->{'FWHM_MIN'} * $cdelt2); # FWHM for star +$outFits->write_key( TSTRING, 'STARPSF', $fwhm, 'Stellar PSF (arcsec)', $status ); +check_fitsio( $status ); + +# Observatory code +$outFits->write_key( TINT, 'OBSCODE', OBSERVATORY_CODE, 'IAU observatory code', $status ); + +# Limiting magnitude +$outFits->write_key( TINT, 'LIMITMAG', FAKE_LIMITING_MAG, 'Limiting magnitude (FAKE)', $status ); + +# Detection efficiency +$outFits->write_key( TINT, 'DE1', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE2', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE3', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE4', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE5', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE6', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE7', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE8', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE9', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); +$outFits->write_key( TINT, 'DE10', FAKE_DETECTION_EFFICIENCY, 'Detection efficiency (FAKE)', $status ); + +# Write the data +for (my $i = 0; $i < scalar @colNames; $i++) { + my $colName = $colNames[$i];# Column name + $outFits->write_col( TDOUBLE, $i + 1, 1, 1, $numRows, $colData{$colName}, $status ); + check_fitsio( $status ); +} + +$outFits->close_file( $status ); + +### Pau. + + +# Read a column specified by name +sub column +{ + my $fits = shift; # FITS file + my $name = shift; # Name of column + my $rows = shift; # Number of rows + my $status = 0; # Status of CFITSIO + + my $num; # Column number + $fits->get_colnum(0, $name, $num, $status) and check_fitsio($status); + my $type; # Type of column + $inFits->get_coltype($num, $type, undef, undef, $status) and check_fitsio($status); + my $data; # Array with data + $inFits->read_col($type, $num, 1, 1, $rows, 0, $data, undef, $status) and check_fitsio($status); + + return $data; +} + + + + +# From Astro::FITS::CFITSIO demo +sub check_fitsio +{ + my $status = shift; # Status of FITSIO calls + + if ($status != 0) { + my $msg; # Message to output + Astro::FITS::CFITSIO::fits_get_errstatus( $status , $msg ); + die "CFITSIO error: $msg\n"; + } +} + +__END__ + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_camera.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_camera.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_camera.pl (revision 41105) @@ -0,0 +1,85 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( caturi ); +use Data::Dumper; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($dbname, # Database name to use + $workdir_default, # Default working directory + $verbose, # Verbose operations? + $no_op, # No operations? + $no_update, # No updating? + ); +GetOptions( + 'dbname=s' => \$dbname, + 'workdir=s' => \$workdir_default, + 'verbose' => \$verbose, + 'no-op' => \$no_op, + 'no-update' => \$no_update, +) or pod2usage( 2 ); + +pod2usage( + -msg => "Required options: --dbname", + -exitval => 3, + ) unless defined $dbname; + +$workdir_default = `pwd` unless defined $workdir_default; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser +my $ipprc = PS::IPP::Config->new; # IPP Configuration + +# Look for programs we need +my $missing_tools; +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $camera_exp = can_run('camera_exp.pl') or (warn "Can't find camera_exp.pl" and $missing_tools = 1); +die "Can't find required tools.\n" if $missing_tools; + +# Camera exposure processing +my $list; +{ + my $command = "$camtool -pendingexp -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get camera exposure list: $error_code\n" if not $success; + $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from camtool.\n"; +} + +foreach my $item (@$list) { + my $cam_id = $item->{cam_id}; + my $exp_tag = $item->{exp_tag}; + my $camera = $item->{camera}; + my $workdir = $item->{workdir}; + + $workdir = $workdir_default unless (defined $workdir or $workdir ne "NULL"); + my $outroot = caturi( $workdir, $exp_tag, "$exp_tag.cm.$cam_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$camera_exp --cam_id $cam_id --exp_tag $exp_tag --camera $camera --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do camera processing on $cam_id: $error_code\n" if not $success; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_chip.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_chip.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_chip.pl (revision 41105) @@ -0,0 +1,107 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( caturi ); +use Data::Dumper; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($dbname, # Database name to use + $workdir_default, # Default working directory + $verbose, # Verbose operations? + $no_op, # No operations? + $no_update, # No updating? + ); +GetOptions( + 'dbname=s' => \$dbname, + 'workdir=s' => \$workdir_default, + 'verbose' => \$verbose, + 'no-op' => \$no_op, + 'no-update' => \$no_update, +) or pod2usage( 2 ); + +pod2usage( -msg => "Required options: --dbname --workdir", + -exitval => 3, + ) unless + defined $dbname; + +$workdir_default = `pwd` unless defined $workdir_default; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser +my $ipprc = PS::IPP::Config->new; # IPP Configuration + +# Look for programs we need +my $missing_tools; +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $chip = can_run('chip_imfile.pl') or (warn "Can't find chip_imfile.pl" and $missing_tools = 1); +die "Can't find required tools.\n" if $missing_tools; + +# Imfile processing +my @whole; # The whole list for processing +{ + my $command = "$chiptool -pendingimfile -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get phase 2 imfile list: $error_code\n" if not $success; + @whole = split /\n/, join( '', @$stdout_buf ); +} + +my @single = (); + +while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ) or + die "Unable to parse output from chiptool.\n"; + + foreach my $item (@$list) { + my $chip_id = $item->{chip_id}; + my $exp_id = $item->{exp_id}; + my $exp_tag = $item->{exp_tag}; + my $chip_imfile_id = $item->{chip_imfile_id}; + my $camera = $item->{camera}; + my $class_id = $item->{class_id}; + my $uri = $item->{uri}; + my $reduction = $item->{reduction}; + my $state = $item->{state}; + my $workdir = $item->{workdir}; + $workdir = $workdir_default unless (defined $workdir or $workdir ne "NULL"); + + my $outroot = caturi( $workdir, $exp_tag, "$exp_tag.ch.$chip_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$chip --chip_id $chip_id --chip_imfile_id $chip_imfile_id --exp_id $exp_id --class_id $class_id --uri $uri --dbname $dbname --camera $camera --outroot $outroot --run-state $state"; + $command .= " --reduction $reduction" if defined $reduction; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do phase 2 processing on $chip_id $class_id: $error_code\n" if not $success; + } + + @single = (); + + } +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_detrend.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_detrend.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_detrend.pl (revision 41105) @@ -0,0 +1,377 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use Getopt::Long; +use Pod::Usage qw( pod2usage ); +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( caturi ); +use Data::Dumper; + +my ($dbname, # Database name to use + $workdir_global, # Global working directory + $verbose, # Produce verbose output? + ); +GetOptions( + 'dbname=s' => \$dbname, + 'workdir=s' => \$workdir_global, + 'verbose' => \$verbose, +) or pod2usage( 2 ); + +pod2usage( + -msg => "Required options: --dbname", + -exitval => 3, + ) unless defined $dbname; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +# Look for programs we need +my $missing_tools; +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $detrend_process_imfile = can_run('detrend_process_imfile.pl') or (warn "Can't find detrend_process_imfile.pl" and $missing_tools = 1); +my $detrend_process_exp = can_run('detrend_process_exp.pl') or (warn "Can't find detrend_process_exp.pl" and $missing_tools = 1); +my $detrend_stack = can_run('detrend_stack.pl') or (warn "Can't find detrend_stack.pl" and $missing_tools = 1); +my $detrend_norm_calc = can_run('detrend_norm_calc.pl') or (warn "Can't find detrend_norm_calc.pl" and $missing_tools = 1); +my $detrend_norm_apply = can_run('detrend_norm_apply.pl') or (warn "Can't find detrend_norm_apply.pl" and $missing_tools = 1); +my $detrend_norm_exp = can_run('detrend_norm_exp.pl') or (warn "Can't find detrend_norm_exp.pl" and $missing_tools = 1); +my $detrend_resid_imfile = can_run('detrend_resid_imfile.pl') or (warn "Can't find detrend_resid_imfile.pl" and $missing_tools = 1); +my $detrend_resid_exp = can_run('detrend_resid_exp.pl') or (warn "Can't find detrend_resid_exp.pl" and $missing_tools = 1); +my $detrend_reject_exp = can_run('detrend_reject_exp.pl') or (warn "Can't find detrend_reject_exp.pl" and $missing_tools = 1); +die "Can't find required tools.\n" if $missing_tools; + +# Process raw imfiles +{ + my $command = "$dettool -toprocessedimfile -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get detrend raw list: $error_code\n" if not $success; + + my @whole = split /\n/, join( '', @$stdout_buf ); + my @single = (); + + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $det_id = $item->{det_id}; + my $det_type = $item->{det_type}; + my $exp_tag = $item->{exp_tag}; + my $exp_id = $item->{exp_id}; + my $class_id = $item->{class_id}; + my $uri = $item->{uri}; + my $camera = $item->{camera}; + my $workdir = $item->{workdir}; + my $reduction = $item->{reduction}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", $exp_tag, "$exp_tag.detproc.$det_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_process_imfile --det_id $det_id --exp_tag $exp_tag --exp_id $exp_id --class_id $class_id --det_type $det_type --input_uri $uri --camera $camera --dbname $dbname --outroot $outroot"; + $command .= " --reduction $reduction" if defined $reduction; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do raw imfile processing on $exp_tag $class_id: $error_code\n" if not $success; + } + + @single = (); + + } + } +} + +# Process raw exposures +{ + my $command = "$dettool -toprocessedexp -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get detrend raw list: $error_code\n" if not $success; + my $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $exp_tag = $item->{exp_tag}; + my $exp_id = $item->{exp_id}; + my $camera = $item->{camera}; + my $det_id = $item->{det_id}; + my $det_type = $item->{det_type}; + my $workdir = $item->{workdir}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", $exp_tag, "$exp_tag.detproc.$det_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_process_exp --det_id $det_id --det_type $det_type --exp_tag $exp_tag --exp_id $exp_id --camera $camera --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do raw exposure processing on $det_id $exp_tag: $error_code\n" if not $success; + } +} + +# Stack +{ + my $command = "$dettool -tostacked -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get stack list: $error_code\n" if not $success; + my $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $det_id = $item->{det_id}; + my $iteration = $item->{iteration}; + my $class_id = $item->{class_id}; + my $det_type = $item->{det_type}; + my $camera = $item->{camera}; + my $workdir = $item->{workdir}; + my $reduction = $item->{reduction}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", "$camera.$det_type.$det_id.$iteration" ); + $ipprc->outroot_prepare( $outroot ); + + + my $command = "$detrend_stack --det_id $det_id --iteration $iteration --class_id $class_id --det_type $det_type --camera $camera --dbname $dbname --outroot $outroot"; + $command .= " --reduction $reduction" if defined $reduction; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to stack detrend $det_id $iteration $class_id: $error_code\n" if not $success; + } +} + +# Calculate normalisation +{ + my $command = "$dettool -tonormalizedstat -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get normalise calculation list: $error_code\n" if not $success; + my $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $det_id = $item->{det_id}; + my $iteration = $item->{iteration}; + my $det_type = $item->{det_type}; + my $camera = $item->{camera}; + my $workdir = $item->{workdir}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", "$camera.$det_type.normstat.$det_id.$iteration" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_norm_calc --det_id $det_id --iteration $iteration --det_type $det_type --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to calculate normalisation for $det_id $iteration: $error_code\n" if not $success; + } +} + +# Apply normalisation +{ + my $command = "$dettool -tonormalize -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get normalisation list: $error_code\n" if not $success; + my $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $det_id = $item->{det_id}; + my $iteration = $item->{iteration}; + my $det_type = $item->{det_type}; + my $class_id = $item->{class_id}; + my $value = $item->{norm}; + my $uri = $item->{uri}; + my $camera = $item->{camera}; + my $workdir = $item->{workdir}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", "$camera.$det_type.norm.$det_id.$iteration" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_norm_apply --det_id $det_id --iteration $iteration --class_id $class_id --value $value --input_uri $uri --camera $camera --det_type $det_type --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to apply normalisation for $det_id $iteration $class_id: $error_code\n" if not $success; + } +} + +# Examine normalised exposure +{ + my $command = "$dettool -tonormalizedexp -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get normalised exposures list: $error_code\n" if not $success; + my $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $det_id = $item->{det_id}; + my $iteration = $item->{iteration}; + my $det_type = $item->{det_type}; + my $class_id = $item->{class_id}; + my $value = $item->{norm}; + my $uri = $item->{uri}; + my $camera = $item->{camera}; + my $workdir = $item->{workdir}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", "$camera.$det_type.normexp.$det_id.$iteration" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_norm_exp --det_id $det_id --iteration $iteration --camera $camera --det_type $det_type --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to examine normalised exposure for $det_id $iteration: $error_code\n" if not $success; + } +} + +# Get residuals +{ + my $command = "$dettool -toresidimfile -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get residual processing list: $error_code\n" if not $success; + + my @whole = split /\n/, join( '', @$stdout_buf ); + my @single = (); + + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $exp_tag = $item->{exp_tag}; + my $exp_id = $item->{exp_id}; + my $camera = $item->{camera}; + my $det_id = $item->{det_id}; + my $iteration = $item->{iteration}; + my $class_id = $item->{class_id}; + my $det_type = $item->{det_type}; + my $detrend = $item->{det_uri}; + my $uri = $item->{uri}; + my $mode = $item->{mode}; + my $workdir = $item->{workdir}; + my $reduction = $item->{reduction}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", $exp_tag, "$exp_tag.detresid.$det_id.$iteration" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_resid_imfile --det_id $det_id --iteration $iteration --exp_tag $exp_tag --exp_id $exp_id --class_id $class_id --det_type $det_type --camera $camera --input_uri $uri --mode $mode --dbname $dbname --outroot $outroot"; + $command .= " --reduction $reduction" if defined $reduction; + $command .= " --detrend $detrend" if defined $detrend; + $command .= " --verbose" if defined $verbose; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do residual processing on $exp_tag $class_id: $error_code\n" if not $success; + } + + @single = (); + + } + } +} + +# Reject based on imfiles +{ + my $command = "$dettool -toresidexp -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get residual imfile list: $error_code\n" if not $success; + my $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $exp_tag = $item->{exp_tag}; + my $exp_id = $item->{exp_id}; + my $camera = $item->{camera}; + my $det_id = $item->{det_id}; + my $iteration = $item->{iteration}; + my $det_type = $item->{det_type}; + my $workdir = $item->{workdir}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", $exp_tag, "$exp_tag.detresid.$det_id.$iteration" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_resid_exp --det_id $det_id --iteration $iteration --exp_tag $exp_tag --exp_id $exp_id --det_type $det_type --camera $camera --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do imfile rejection on $exp_tag $det_id $iteration: $error_code\n" if not $success; + } +} + +# Reject based on exposures +{ + my $command = "$dettool -todetrunsummary -dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get residual exposure list: $error_code\n" if not $success; + my $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from dettool.\n"; + + foreach my $item (@$list) { + my $camera = $item->{camera}; + my $det_id = $item->{det_id}; + my $iteration = $item->{iteration}; + my $det_type = $item->{det_type}; + my $workdir = $item->{workdir}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, "$camera.$det_type.$det_id", "$camera.$det_type.$det_id.$iteration.detreject" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$detrend_reject_exp --det_id $det_id --iteration $iteration --det_type $det_type --camera $camera --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do exposure rejection on $det_id $iteration: $error_code\n" if not $success; + } +} + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_diff.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_diff.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_diff.pl (revision 41105) @@ -0,0 +1,96 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +my ($dbname, # Database name to use + $verbose, # Verbose operations? + $workdir_global, # Global working directory + $no_op, # No operations? + $no_update, # No updating? + ); +GetOptions( + 'dbname=s' => \$dbname, + 'verbose' => \$verbose, + 'workdir' => \$workdir_global, + 'no-op' => \$no_op, + 'no-update' => \$no_update, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "Required options: --dbname", + -exitval => 3, + ) unless defined $dbname; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser + +# Look for programs we need +my $missing_tools; +my $difftool = can_run('difftool') or + (warn "Can't find difftool" and $missing_tools = 1); +my $diff_skycell = can_run('diff_skycell.pl') or + (warn "Can't find diff_skycell.pl" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + + +# Image differencing +{ + my $list; + my $command = "$difftool -todiffskyfile -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get list of diffs: $error_code\n" if not $success; + $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from difftool.\n"; + + foreach my $item (@$list) { + my $diff_id = $item->{diff_id}; + my $skycell_id = $item->{skycell_id}; + my $tess_id = basename($item->{tess_id}); + my $workdir = $item->{workdir}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, $tess_id, $skycell_id, "$tess_id.$skycell_id.dif.$diff_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$diff_skycell --diff_id $diff_id --skycell_id $skycell_id --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do difference for $diff_id: $error_code\n" if not $success; + } +} + + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject.pl (revision 41105) @@ -0,0 +1,143 @@ +#!/usr/bin/env perl + +# this program injects a list of single-file exposures into the db, +# taking the filename (without .fits) as the exp_tag. the user +# supplies a temporary telescope and camera name. these are used +# for informational purposes only until the registration step can +# determine the true telescope and camera name from the image +# headers. + +# this program should not fail because of the data format or the +# configuration, except for the very basic database setup. + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use PS::IPP::Config; + +my $ipprc = PS::IPP::Config->new(); # this is used for PATH, NEB filename conversions + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($camera, $telescope, $workdir, $reduction, $dvo_db, $tess_id, $end_stage, $label, $dbname, $no_op, $help); +GetOptions('camera|i=s' => \$camera, # user-supplied camera name + 'telescope|t=s' => \$telescope, # user-supplied telescope name + 'workdir|w=s' => \$workdir, # working directory for output files + 'reduction=s' => \$reduction, # user-supplied camera name + 'dvodb=s' => \$dvo_db, # target dvo database + 'tess_id=s' => \$tess_id, # tessalation for warping + 'end_stage=s' => \$end_stage, # stop processing at this step + 'label=s' => \$label, # set chip label + 'dbname|d=s' => \$dbname, # Database name + 'no-op' => \$no_op, # pretend but don't actually inject + 'help' => \$help # give help listing +) or pod2usage( 2 ); + +pod2usage( -msg => "inject one or many files into the IPP pipeline database", + -exitval => 2) if + defined $help; + +pod2usage( -msg => "Usage: $0 --telescope (name) --camera (name) [--workdir path] [--reduction class] [--dvodb db] [--tess_id tess] [--end_stage stage] [--label label] [--dbname dbname] (files)", + -exitval => 2 ) if + scalar @ARGV == 0; + +pod2usage( -msg => "Required options: --telescope (name) --camera (name)", + -exitval => 3) unless + defined $telescope and + defined $camera; + +my $pxinject = can_run('pxinject') or die "Can't find pxinject\n"; + +# if workdir is not defined, assign the current path +# XXX we need to handle relative paths for workdir (not allowed) +if (! $workdir) { + $workdir = File::Spec->rel2abs( "." ); +} + +my $num = 0; +foreach my $file ( @ARGV ) { + # check for file existence + if (! -e $file) { die "file $file not found\n"; } + my $absfile = File::Spec->rel2abs( $file ); + inject($absfile, $workdir, $dbname, $telescope, $camera); + $num ++; +} + +print "$num files injected.\n"; + +sub inject +{ + my $absfile = shift; # absolute path for this file + my $workdir = shift; # absolute path for output directory + my $dbname = shift; # IPP database to use + my $telescope = shift; # user-specified telescope + my $camera = shift; # user-specified camera + + # XXX provide an option for an alternative extension + my ( $vol, $path, $name ) = File::Spec->splitpath( $absfile ); + my ( $exp_name ) = $name =~ /(.*)\.(fits|fit|fts)(|.gz)/; + $exp_name =~ s|\s|_|g; + + my $relfile = $ipprc->convert_filename_relative( $absfile ); + + # the telescope, instrument, and exp_name used here are temporary : register replaces them with the true values + my $command_exp = "$pxinject -newExp"; + $command_exp .= " -tmp_exp_name $exp_name"; + $command_exp .= " -tmp_inst $camera"; + $command_exp .= " -tmp_telescope $telescope"; + $command_exp .= " -workdir $workdir"; + $command_exp .= " -reduction $reduction" if defined $reduction; + $command_exp .= " -dvodb $dvo_db" if defined $dvo_db; + $command_exp .= " -tess_id $tess_id" if defined $tess_id; + $command_exp .= " -end_stage $end_stage" if defined $end_stage; + $command_exp .= " -label $label" if defined $label; + $command_exp .= " -dbname $dbname" if defined $dbname; + + my $exp_id = 0; + unless ($no_op) { + my ( $success_exp, $error_code_exp, $full_buf_exp, $stdout_buf_exp, $stderr_buf_exp ) = + run( command => $command_exp, verbose => 1 ); + die "Unable to inject $exp_name: $error_code_exp\n" if not $success_exp; + + my @line = split(/\s+/, $$stdout_buf_exp[0]); # The output line, containing the exposure tag + $exp_id = $line[2]; # The exposure tag + } else { + print "skipping command: $command_exp\n"; + } + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_imfile = "$pxinject -newImfile"; + $command_imfile .= " -exp_id $exp_id"; + $command_imfile .= " -tmp_class_id fpa"; + $command_imfile .= " -uri '$relfile'"; + $command_imfile .= " -dbname $dbname" if defined ($dbname); + + unless ($no_op) { + my ( $success_imfile, $error_code_imfile, $full_buf_imfile, $stdout_buf_imfile, $stderr_buf_imfile ) = run( command => $command_imfile, verbose => 1 ); + die "Unable to inject $exp_name imfile: $error_code_imfile\n" if not $success_imfile; + } else { + print "skipping command: $command_imfile\n"; + } + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_update = "$pxinject -updatenewExp"; + $command_update .= " -exp_id $exp_id"; + $command_update .= " -state run"; + $command_update .= " -dbname $dbname" if defined ($dbname); + + unless ($no_op) { + my ( $success_update, $error_code_update, $full_buf_update, $stdout_buf_update, $stderr_buf_update ) = run( command => $command_update, verbose => 1 ); + die "Unable to update $exp_name: $error_code_update\n" if not $success_update; + } else { + print "skipping command: $command_update\n"; + } + + return 1; +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_into_nebulous.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_into_nebulous.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_into_nebulous.pl (revision 41105) @@ -0,0 +1,169 @@ +#!/usr/bin/env perl + +# this program injects a list of single-file exposures into the db, +# taking the filename (without .fits) as the exp_tag. the user +# supplies a temporary telescope and camera name. these are used +# for informational purposes only until the registration step can +# determine the true telescope and camera name from the image +# headers. + +# this program should not fail because of the data format or the +# configuration, except for the very basic database setup. + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use PS::IPP::Config; + +my $ipprc = PS::IPP::Config->new(); # this is used for PATH, NEB filename conversions + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($camera, $telescope, $workdir, $reduction, $dvo_db, $tess_id, $end_stage, $label, $dbname, $no_op, $help); +GetOptions('camera|i=s' => \$camera, # user-supplied camera name + 'telescope|t=s' => \$telescope, # user-supplied telescope name + 'workdir|w=s' => \$workdir, # working directory for output files + 'reduction=s' => \$reduction, # user-supplied camera name + 'dvodb=s' => \$dvo_db, # target dvo database + 'tess_id=s' => \$tess_id, # tessalation for warping + 'end_stage=s' => \$end_stage, # stop processing at this step + 'label=s' => \$label, # set chip label + 'dbname|d=s' => \$dbname, # Database name + 'no-op' => \$no_op, # pretend but don't actually inject + 'help' => \$help # give help listing +) or pod2usage( 2 ); + +pod2usage( -msg => "inject one or many files into the IPP pipeline database", + -exitval => 2) if + defined $help; + +pod2usage( -msg => "Usage: $0 --telescope (name) --camera (name) [--workdir path] [--reduction class] [--dvodb db] [--tess_id tess] [--end_stage stage] [--label label] [--dbname dbname] (files)", + -exitval => 2 ) if + scalar @ARGV == 0; + +pod2usage( -msg => "Required options: --telescope (name) --camera (name)", + -exitval => 3) unless + defined $telescope and + defined $camera; + +my $pxinject = can_run('pxinject') or die "Can't find pxinject\n"; + +# if workdir is not defined, assign the current path +# XXX we need to handle relative paths for workdir (not allowed) +if (! $workdir) { + $workdir = File::Spec->rel2abs( "." ); +} + +my $num = 0; +foreach my $file ( @ARGV ) { + # check for file existence + if (! -e $file) { die "file $file not found\n"; } + my $absfile = File::Spec->rel2abs( $file ); + + #copy into nebulous + my $neb_part=$absfile; + $neb_part =~s/.*\///g; + my $base = $neb_part; + $base =~s/.fits//; + + print "$workdir/$base/$neb_part\n"; + + + `neb-touch $workdir/$base/$neb_part`; + my @paths = `neb-locate --path $workdir/$base/$neb_part`; + foreach my $path (@paths) { + chomp $path; + my @cperr = `cp $absfile $path 2>&1`; + if ($#cperr > 0) { + print "error copying $absfile $path\n"; + } + } + `neb-replicate $workdir/$base/$neb_part --set_copies 2`; + my $numofcopies = `neb-stat $workdir/$base/$neb_part | grep available`; + $numofcopies =~ s/available instances: //; + if ($numofcopies < 2) { + print "problem: less than 2 copies of $workdir/$base/$neb_part\n"; + } + + inject("$workdir/$base/$neb_part", $workdir, $dbname, $telescope, $camera); + $num ++; +} + +print "$num files injected.\n"; + +sub inject +{ + my $absfile = shift; # absolute path for this file + my $workdir = shift; # absolute path for output directory + my $dbname = shift; # IPP database to use + my $telescope = shift; # user-specified telescope + my $camera = shift; # user-specified camera + + # XXX provide an option for an alternative extension + my ( $vol, $path, $name ) = File::Spec->splitpath( $absfile ); + my ( $exp_name ) = $name =~ /(.*)\.(fits|fit|fts)(|.gz)/; + $exp_name =~ s|\s|_|g; + + my $relfile = $ipprc->convert_filename_relative( $absfile ); + + # the telescope, instrument, and exp_name used here are temporary : register replaces them with the true values + my $command_exp = "$pxinject -newExp"; + $command_exp .= " -tmp_exp_name $exp_name"; + $command_exp .= " -tmp_inst $camera"; + $command_exp .= " -tmp_telescope $telescope"; + $command_exp .= " -workdir $workdir"; + $command_exp .= " -reduction $reduction" if defined $reduction; + $command_exp .= " -dvodb $dvo_db" if defined $dvo_db; + $command_exp .= " -tess_id $tess_id" if defined $tess_id; + $command_exp .= " -end_stage $end_stage" if defined $end_stage; + $command_exp .= " -label $label" if defined $label; + $command_exp .= " -dbname $dbname" if defined $dbname; + + my $exp_id = 0; + unless ($no_op) { + my ( $success_exp, $error_code_exp, $full_buf_exp, $stdout_buf_exp, $stderr_buf_exp ) = + run( command => $command_exp, verbose => 1 ); + die "Unable to inject $exp_name: $error_code_exp\n" if not $success_exp; + + my @line = split(/\s+/, $$stdout_buf_exp[0]); # The output line, containing the exposure tag + $exp_id = $line[2]; # The exposure tag + } else { + print "skipping command: $command_exp\n"; + } + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_imfile = "$pxinject -newImfile"; + $command_imfile .= " -exp_id $exp_id"; + $command_imfile .= " -tmp_class_id fpa"; + $command_imfile .= " -uri '$relfile'"; + $command_imfile .= " -dbname $dbname" if defined ($dbname); + + unless ($no_op) { + my ( $success_imfile, $error_code_imfile, $full_buf_imfile, $stdout_buf_imfile, $stderr_buf_imfile ) = run( command => $command_imfile, verbose => 1 ); + die "Unable to inject $exp_name imfile: $error_code_imfile\n" if not $success_imfile; + } else { + print "skipping command: $command_imfile\n"; + } + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_update = "$pxinject -updatenewExp"; + $command_update .= " -exp_id $exp_id"; + $command_update .= " -state run"; + $command_update .= " -dbname $dbname" if defined ($dbname); + + unless ($no_op) { + my ( $success_update, $error_code_update, $full_buf_update, $stdout_buf_update, $stderr_buf_update ) = run( command => $command_update, verbose => 1 ); + die "Unable to update $exp_name: $error_code_update\n" if not $success_update; + } else { + print "skipping command: $command_update\n"; + } + + return 1; +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_mosaic.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_mosaic.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_mosaic.pl (revision 41105) @@ -0,0 +1,169 @@ +#!/usr/bin/env perl + +# this program injects a set of multi-file exposures into the db. the +# program takes a list of base exposure names and injects all files +# associated with the exposure. It constructs the expected filenames +# from the exposure tag and rules for the camera. This program is for +# the test only since it requires too much information at the inject +# stage. use 'ipp_serial_inject.pl' for single-file images and +# 'ipp_serial_inject_split.pl' for multiple file images in split +# format + +# this program should not fail because of the data format or the +# configuration, except for the very basic database setup. + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Config qw( caturi ); +use Data::Dumper; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($camera, # Camera used + $telescope, # Telescope used + $tess_id, # Tessellation identifier + $dbname, # Database name + $workdir, # Working directory + $path, # Path to data + ); +GetOptions( + 'camera|c=s' => \$camera, + 'telescope|t=s' => \$telescope, + 'workdir=s' => \$workdir, + 'tess_id=s' => \$tess_id, + 'path=s' => \$path, + 'dbname=s' => \$dbname, +) or pod2usage( 2 ); + +pod2usage( + -msg => "Required options: --camera --telescope --workdir --path --dbname --tess_id", + -exitval => 3, + ) unless defined $camera + and defined $telescope + and defined $workdir + and defined $path + and defined $dbname + and defined $tess_id; + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +# Look for programs we need +my $missing_tools; +my $pxinject = can_run('pxinject') or (warn "Can't find pxinject" and $missing_tools = 1); + +if (scalar @ARGV == 0) { + die "No exposures provided.\n"; +} + +# Inject new data into the database +my @classes; # Names of the classes +my @files; # What to add to the filename for each class +my $imfiles; +my $add_dir; # Add directory name to get file name? +if ($camera eq "MEGACAM") { + for (my $i = 0; $i < 36; $i++) { + push @classes, sprintf("ccd%02d", $i); + push @files, sprintf(".ccd%02d", $i); + } +} elsif ($camera eq "MCSHORT") { + @classes = ( 'ccd12', 'ccd13', 'ccd14', 'ccd21', 'ccd22', 'ccd23' ); + @files = ( '.ccd12', '.ccd13', '.ccd14', '.ccd21', '.ccd22', '.ccd23' ); +} elsif ($camera eq "CTIO_MOSAIC2") { + @classes = (); + @files = (); +} elsif ($camera eq "TC3") { + @classes = ( 'CCID58-1-06b2', 'CCID45-1-14A', 'CCID45-1-11A', 'CCID45-1-22A', + 'CCID45-1-04C', 'CCID45-1-13A', 'CCID45-1-05A', 'CCID45-1-19A' ); + @files = ( '00', '01', '10', '11', '20', '21', '30', '31' ); + $add_dir = 1; +} elsif ($camera eq "SIMMOSAIC") { + @classes = ( 'Chip00', 'Chip01', 'Chip10', 'Chip11' ); + @files = ( '.Chip00', '.Chip01', '.Chip10', '.Chip11' ); +} elsif ($camera eq "SIMTEST") { + @classes = (); + @files = (); +} elsif ($camera eq "GPC1") { + for (my $i = 0; $i < 8; $i++) { + for (my $j = 0; $j < 8; $j++) { + if (($i == 0 or $i == 7) and ($j == 0 or $j == 7)) { + # Excluding corner chips + next; + } + push @classes, "XY$i$j"; + push @files, "$i$j"; + } + } + $add_dir = 1; +} else { + die "Unrecognised camera name: $camera.\nDid you mean to use ipp_serial_inject.pl?\n"; +} + +foreach my $exp_name ( @ARGV ) { + my $command = "$pxinject -newExp -tmp_exp_name $exp_name -tmp_inst $camera -tmp_telescope $telescope -workdir $workdir -tess_id $tess_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to inject $exp_name: $error_code\n" if not $success; + + my @line = split(/\s+/, $$stdout_buf[0]); # The output line, containing the exposure tag + my $exp_id = $line[2]; # The exposure tag + for (my $i = 0; $i < scalar @classes; $i++) { + my $class_id = $classes[$i]; + my $file_id = $files[$i]; + my $filename = $exp_name . $file_id . '.fits'; + $filename = caturi( $exp_name, $filename ) if defined $add_dir; + $filename = caturi( $path, $filename ); + + die "Unable to find file $filename" unless -f $ipprc->file_resolve( $filename ); + + $filename = $ipprc->convert_filename_relative( $filename ); + my $command = "$pxinject -newImfile -exp_id $exp_id -tmp_class_id $class_id -uri $filename"; # Command to run + $command .= " -dbname $dbname" if defined ($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to inject $exp_name $class_id: $error_code\n" if not $success; + } + + if (scalar @classes == 0) { + my $filename = $exp_name . '.fits'; + $filename = caturi( $exp_name, $filename ) if defined $add_dir; + $filename = caturi( $path, $filename ); + + die "Unable to find file $filename" unless -f $ipprc->file_resolve( $filename ); + + $filename = $ipprc->convert_filename_relative( $filename ); + my $command = "$pxinject -newImfile -exp_id $exp_id -tmp_class_id fpa -uri $filename"; # Command to run + $command .= " -dbname $dbname" if defined ($dbname); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to inject $exp_name imfile: $error_code\n" if not $success; + } + + # Update the exposure to run + { + my $command = "$pxinject -updatenewExp -exp_id $exp_id -state run"; # Command to run + $command .= " -dbname $dbname" if defined ($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to activate $exp_name: $error_code\n" if not $success; + } + +} + +END { + my $status = $?; +system("sync") == 0 + or die "failed to execute sync: $!" ; +$? = $status; +} + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_split.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_split.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_inject_split.pl (revision 41105) @@ -0,0 +1,138 @@ +#!/usr/bin/env perl + +# this program injects a list of multi-file exposures into the db. +# the program takes a list of directory names (dir), and injects all +# dir/*.fits. It takes the directory name as the exp_tag. the user +# supplies a temporary telescope and instrument name. these are used +# for informational purposes only until the registration step can +# determine the true telescope and instrument name from the image +# headers. + +# this program should not fail because of the data format or the +# configuration, except for the very basic database setup. + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use PS::IPP::Config; + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($camera, $telescope, $workdir, $reduction, $dvo_db, $tess_id, $end_stage, $dbname, $help); +GetOptions('camera|c=s' => \$camera, # Camera used + 'telescope|t=s' => \$telescope, # Telescope used + 'workdir|w=s' => \$workdir, # working directory for output files + 'reduction=s' => \$reduction, # user-supplied camera name + 'dvodb=s' => \$dvo_db, # target dvo database + 'tess_id=s' => \$tess_id, # tessalation for warping + 'end_stage=s' => \$end_stage, # stop processing at this step + 'dbname|d=s' => \$dbname, # Database name + 'help' => \$help # give help listing +) or pod2usage( 2 ); + +pod2usage( -msg => "inject one or many image exposures (directories) into the IPP pipeline database", + -exitval => 2) if + defined $help; + +pod2usage( -msg => "Usage: $0 --telescope (name) --camera (name) [--workdir path] [--reduction class] [--dvodb db] [--tess_id tess] [--end_stage stage] [--dbname name] (files)", + -exitval => 2 ) if + scalar @ARGV == 0; + +pod2usage( + -msg => "Required options: --camera --telescope", + -exitval => 3) unless + defined $telescope and + defined $camera; + +# Look for programs we need +my $pxinject = can_run('pxinject') or die "Can't find pxinject\n"; + +# if workdir is not defined, assign the current path +# we need to handle relative paths for workdir (not allowed) +if (! $workdir) { + $workdir = File::Spec->rel2abs( "." ); +} + +my $num = 0; +foreach my $filedir ( @ARGV ) { + # check for filedir existence + if (! -e $filedir) { die "file dir $filedir not found\n"; } + my $absfiledir = File::Spec->rel2abs( $filedir ); + inject($absfiledir, $workdir, $dbname, $telescope, $camera); + $num ++; +} + +sub inject +{ + my $absfiledir = shift; # absolute path for this file + my $workdir = shift; # absolute path for output directory + my $dbname = shift; # IPP database to use + my $telescope = shift; # user-specified telescope + my $camera = shift; # user-specified camera + + # XXX provide an option for an alternative extension + my @files = <$absfiledir/*.fits>; + my $Nfiles = scalar @files; + + print "absfiledir: $absfiledir\n"; + print "Nfiles: $Nfiles\n"; + + # the absfiledir is of the form path://PATH/data/foo/expname + my ( $vol, $path, $exp_name ) = File::Spec->splitpath( $absfiledir ); + + # the telescope, instrument, and exp_name used here are temporary : register replaces them with the true values + my $command_exp = "$pxinject -newExp"; + $command_exp .= " -tmp_exp_name $exp_name"; + $command_exp .= " -tmp_inst $camera"; + $command_exp .= " -tmp_telescope $telescope"; + $command_exp .= " -workdir $workdir"; + $command_exp .= " -reduction $reduction" if defined $reduction; + $command_exp .= " -dvodb $dvo_db" if defined $dvo_db; + $command_exp .= " -tess_id $tess_id" if defined $tess_id; + $command_exp .= " -end_stage $end_stage" if defined $end_stage; + $command_exp .= " -dbname $dbname" if defined $dbname; + + my ( $success_exp, $error_code_exp, $full_buf_exp, $stdout_buf_exp, $stderr_buf_exp ) = + run( command => $command_exp, verbose => 1 ); + die "Unable to inject $exp_name: $error_code_exp\n" if not $success_exp; + + my @line = split(/\s+/, $$stdout_buf_exp[0]); # The output line, containing the exposure tag + my $exp_id = $line[2]; # The exposure tag + + foreach my $absfile (@files) { + + my $relfile = $ipprc->convert_filename_relative( $absfile ); + + my ( $tmpvol, $tmppath, $filename ) = File::Spec->splitpath( $absfile ); + my ( $class_name ) = $filename =~ /(.*)\.fits/; + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_imfile = "$pxinject -newImfile"; + $command_imfile .= " -exp_id $exp_id"; + $command_imfile .= " -tmp_class_id $class_name"; + $command_imfile .= " -uri $relfile"; + $command_imfile .= " -dbname $dbname" if defined ($dbname); + + my ( $success_imfile, $error_code_imfile, $full_buf_imfile, $stdout_buf_imfile, $stderr_buf_imfile ) = run( command => $command_imfile, verbose => 1 ); + die "Unable to inject $exp_name imfile: $error_code_imfile\n" if not $success_imfile; + } + + # the class_id used here is temporary : register replaces it with the true class_id + my $command_update = "$pxinject -updatenewExp"; + $command_update .= " -exp_id $exp_id"; + $command_update .= " -state run"; + $command_update .= " -dbname $dbname" if defined ($dbname); + + my ( $success_update, $error_code_update, $full_buf_update, $stdout_buf_update, $stderr_buf_update ) = run( command => $command_update, verbose => 1 ); + die "Unable to update $exp_name: $error_code_update\n" if not $success_update; + + return 1; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_magic.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_magic.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_magic.pl (revision 41105) @@ -0,0 +1,157 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( caturi ); +use Data::Dumper; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($dbname, # Database name to use + $identifier, # Identifier to process + $workdir_default, # Default working directory + $verbose, # Verbose operations? + $no_op, # No operations? + $no_update, # No updating? + ); +GetOptions( 'dbname=s' => \$dbname, + 'magic_id=s' => \$identifier, + 'workdir=s' => \$workdir_default, + 'verbose' => \$verbose, + 'no-op' => \$no_op, + 'no-update' => \$no_update, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Required options: --dbname --workdir", + -exitval => 3, + ) unless + defined $dbname; + +$workdir_default = `pwd` unless defined $workdir_default; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser +my $ipprc = PS::IPP::Config->new; # IPP Configuration + +# Look for programs we need +my $missing_tools; +my $magictool = can_run('magictool') or (warn "Can't find magictool" and $missing_tools = 1); +my $magic_tree = can_run('magic_tree.pl') or (warn "Can't find magic_tree.pl" and $missing_tools = 1); +my $magic_process = can_run('magic_process.pl') or (warn "Can't find magic_process.pl" and $missing_tools = 1); +die "Can't find required tools.\n" if $missing_tools; + +# Tree +{ + my @whole; # The whole list for processing + { + my $command = "$magictool -totree -dbname $dbname"; # Command to run + $command .= " -magic_id $identifier" if defined $identifier; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => $verbose ); + die "Unable to get magic tree list: $error_code\n" if not $success; + @whole = split /\n/, join( '', @$stdout_buf ); + } + + my @single = (); + + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ) or + die "Unable to parse output from magictool.\n"; + + foreach my $item (@$list) { + my $magic_id = $item->{magic_id}; + my $exp_id = $item->{exp_id}; + my $camera = $item->{camera}; + my $tess_id = $item->{tess_id}; + my $ra = $item->{ra}; + my $dec = $item->{decl}; + my $workdir = $item->{workdir}; + $workdir = $workdir_default unless (defined $workdir or $workdir ne "NULL"); + + my $outroot = caturi( $workdir, $exp_id, "$exp_id.mgc.$magic_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$magic_tree --magic_id $magic_id --camera $camera --tess_id $tess_id --outroot $outroot --ra $ra --dec $dec --dbname $dbname"; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => $verbose ); + die "Unable to do magic tree on $magic_id: $error_code\n" if not $success; + } + + @single = (); + } + } +} + +# Process leaf +{ + my @whole; # The whole list for processing + { + my $command = "$magictool -toprocess -dbname $dbname"; # Command to run + $command .= " -magic_id $identifier" if defined $identifier; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => $verbose ); + die "Unable to get magic tree list: $error_code\n" if not $success; + @whole = split /\n/, join( '', @$stdout_buf ); + } + + my @single = (); + + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ) or + die "Unable to parse output from magictool.\n"; + + foreach my $item (@$list) { + my $magic_id = $item->{magic_id}; + my $exp_id = $item->{exp_id}; + my $camera = $item->{camera}; + my $node = $item->{node}; + my $workdir = $item->{workdir}; + $workdir = $workdir_default unless (defined $workdir or $workdir ne "NULL"); + + my $outroot = caturi( $workdir, $exp_id, "$exp_id.mgc.$magic_id.$node" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$magic_process --magic_id $magic_id --camera $camera --node $node --outroot $outroot --dbname $dbname"; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => $verbose ); + die "Unable to do magic process on $magic_id $node: $error_code\n" if not $success; + } + + @single = (); + } + } +} + + + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_mops.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_mops.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_mops.pl (revision 41105) @@ -0,0 +1,185 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use DBI; + +use IPC::Cmd 0.36 qw( can_run run ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use Data::Dumper; +use File::Temp qw( tempfile ); + +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( caturi ); +use Carp qw( carp ); + +# Look for programs we need +my $missing_tools; +my $ppmops = can_run('ppMops') or (warn "Can't find ppMops" and $missing_tools = 1); +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +die "Can't find required tools.\n" if $missing_tools; + +my $ipprc = PS::IPP::Config->new; # IPP Configuration + +my ( $dbhost, # Database host + $dbname, # Database name + $dbuser, # Database user + $dbpass, # Database p/w + $camera, # Camera used + $outroot, # Output directory + $fileset, # File set + $label, # Data label to search for + $verbose, # Verbose output? + $no_update, # Don't update state? + $no_op, # Don't do any operations? + $save_temps # Save temporary files? + ); + +GetOptions( + 'dbhost=s' => \$dbhost, + 'dbname=s' => \$dbname, + 'dbuser=s' => \$dbuser, + 'dbpass=s' => \$dbpass, + 'camera=s' => \$camera, + 'outroot=s' => \$outroot, + 'fileset=s' => \$fileset, + 'label=s' => \$label, + 'verbose' => \$verbose, + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'save-temps' => \$save_temps, # Save temporary files? +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dbhost --dbname --dbuser --dbpass --camera --outroot --fileset", + -exitval => 3) + unless defined $dbhost + and defined $dbname + and defined $dbuser + and defined $dbpass + and defined $camera + and defined $outroot + and defined $fileset; + +$ipprc->define_camera($camera); + +my $dbsrc = 'DBI:mysql:database=' . $dbname . ';host=' . $dbhost . + ';mysql_socket=/var/run/mysqld/mysqld.sock'; +my $db = DBI->connect($dbsrc, $dbuser, $dbpass, { RaiseError => 1, AutoCommit => 1 } ) or + die "Unable to connect to database: $DBI::errstr"; + +my $where_label = defined $label ? "AND diffRun.label = '$label'" : ""; # WHERE for label + +my $sql = " +-- Get a list of exposures on which magic may be performed +SELECT + rawExp.exp_id, + MAX(diffWarps.diff_id) AS diff_id, + -- The following trick pulls out the appropriate values for the maximum diff_id + SUBSTRING_INDEX(GROUP_CONCAT(camProcessedTemplate.zpt_obs ORDER BY diffWarps.diff_id), ',', 1) AS zpt_obs, + SUBSTRING_INDEX(GROUP_CONCAT(rawTemplate.exp_time ORDER BY diffWarps.diff_id), ',', 1) AS exp_time, + CONVERT(SUBSTRING_INDEX(GROUP_CONCAT(diffWarps.inverse ORDER BY diffWarps.diff_id), ',', 1), UNSIGNED) AS inverse +FROM ( + -- Forward diffs + SELECT + diffRun.diff_id, + warp1 AS warp_id, + warp1 AS template_warp, + 0 AS inverse + FROM diffRun + JOIN diffInputSkyfile USING(diff_id) + WHERE diffInputSkyfile.warp1 IS NOT NULL + AND diffRun.state = 'full' + AND diffRun.exposure = 1 + $where_label + UNION + -- Backward diffs + SELECT + diffRun.diff_id, + warp2 AS warp_id, + warp1 AS template_warp, + 1 AS inverse + FROM diffRun + JOIN diffInputSkyfile USING(diff_id) + WHERE diffInputSkyfile.warp2 IS NOT NULL + AND diffRun.state = 'full' + AND diffRun.exposure = 1 + AND diffRun.bothways = 1 + $where_label + ) AS diffWarps +JOIN warpRun USING(warp_id) +JOIN fakeRun USING(fake_id) +JOIN camRun USING(cam_id) +JOIN chipRun USING(chip_id) +JOIN rawExp USING(exp_id) +JOIN warpRun AS warpTemplate ON warpTemplate.warp_id = diffWarps.template_warp +JOIN fakeRun AS fakeTemplate ON fakeTemplate.fake_id = warpTemplate.fake_id +JOIN camRun AS camTemplate ON camTemplate.cam_id = fakeTemplate.cam_id +JOIN camProcessedExp AS camProcessedTemplate ON camProcessedTemplate.cam_id = camTemplate.cam_id +JOIN chipRun AS chipTemplate ON chipTemplate.chip_id = camTemplate.chip_id +JOIN rawExp AS rawTemplate ON rawTemplate.exp_id = chipTemplate.exp_id +WHERE rawExp.camera = '$camera' +GROUP BY exp_id;"; + +my $diffs = $db->selectall_arrayref( $sql, { Slice => {} } ) or die "Unable to execute SQL: $DBI::errstr"; + +print "Selected " . scalar @$diffs . " rows.\n"; + +$ipprc->outroot_prepare( $outroot ); +my $outrootResolved = $ipprc->file_resolve( $outroot ); +my ($dsFile, $dsName) = tempfile( "$outrootResolved.dslist.XXXX", UNLINK => !$save_temps); + +foreach my $diff ( @$diffs ) { + my $exp_id = $diff->{exp_id}; + my $zp = $diff->{zpt_obs}; + my $exp_time = $diff->{exp_time}; + my $diff_id = $diff->{diff_id}; + my $inverse = $diff->{inverse}; + + (carp "Bad ZP or EXPTIME for $exp_id" and next) if not defined $zp or not defined $exp_time; + $zp += 2.5 * log($exp_time) / log(10); + + my $sql = "SELECT * FROM diffSkyfile WHERE diff_id = $diff_id AND fault = 0 AND quality = 0;"; + my $skycells = $db->selectall_arrayref( $sql, { Slice => {} } ) or die "Unable to execute SQL: $DBI::errstr"; + + foreach my $skycell ( @$skycells ) { + my $skycell_id = $skycell->{skycell_id}; + my $path_base = $skycell->{path_base}; + + my $sources = $inverse ? "PPSUB.INVERSE.SOURCES" : "PPSUB.OUTPUT.SOURCES"; + + my $input = $ipprc->filename($sources, $path_base); + (carp "Can't find $input\n" and next) unless $ipprc->file_exists($input); + $input = $ipprc->file_resolve($input); + + my $output = caturi( $outroot, "mops.$exp_id.$skycell_id.$diff_id.fits" ); + $output = $ipprc->file_resolve($output); + + unless ($no_op) { + $ipprc->file_prepare($output); + my $command = "$ppmops $input $zp $output"; + my $success = run( command => $command, verbose => $verbose ); + (carp "Couldn't translate $input\n" and next) unless $success; + } + + # format: filename|filesize|md5sum|filetype| + # note: since we omit filesize and md5sum, dsreg will calculate them + print $dsFile "${output}|||ipp-mops|\n"; + } +} +close $dsFile; +$db->disconnect; + +# Register new files with the data store +unless ($no_update) { + my $command = "$dsreg --add $fileset --product mops_transient_detections --type MOPS_TRANSIENT_DETECTIONS --list $dsName --copy --abspath --dbname DataStore"; + my $success = run( command => $command, verbose => $verbose ); + die "Couldn't register files with data store.\n" unless $success; +} + + +__END__ + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_mops_warps.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_mops_warps.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_mops_warps.pl (revision 41105) @@ -0,0 +1,145 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use DBI; + +use IPC::Cmd 0.36 qw( can_run run ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use Data::Dumper; +use File::Temp qw( tempfile ); + +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( caturi ); +use Carp qw( carp ); + +# Look for programs we need +my $missing_tools; +my $ppmops = can_run('ppMops') or (warn "Can't find ppMops" and $missing_tools = 1); +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +die "Can't find required tools.\n" if $missing_tools; + +my $ipprc = PS::IPP::Config->new; # IPP Configuration + +my ( $dbhost, # Database host + $dbname, # Database name + $dbuser, # Database user + $dbpass, # Database p/w + $camera, # Camera used + $outroot, # Output directory + $fileset, # File set + $label, # Data label to search for + $verbose, # Verbose output? + $no_update, # Don't update state? + $no_op, # Don't do any operations? + $save_temps # Save temporary files? + ); + +GetOptions( + 'dbhost=s' => \$dbhost, + 'dbname=s' => \$dbname, + 'dbuser=s' => \$dbuser, + 'dbpass=s' => \$dbpass, + 'camera=s' => \$camera, + 'outroot=s' => \$outroot, + 'fileset=s' => \$fileset, + 'label=s' => \$label, + 'verbose' => \$verbose, + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'save-temps' => \$save_temps, # Save temporary files? +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dbhost --dbname --dbuser --dbpass --camera --outroot --fileset", + -exitval => 3) + unless defined $dbhost + and defined $dbname + and defined $dbuser + and defined $dbpass + and defined $camera + and defined $outroot + and defined $fileset; + +$ipprc->define_camera($camera); + +my $dbsrc = 'DBI:mysql:database=' . $dbname . ';host=' . $dbhost . + ';mysql_socket=/var/run/mysqld/mysqld.sock'; +my $db = DBI->connect($dbsrc, $dbuser, $dbpass, { RaiseError => 1, AutoCommit => 1 } ) or + die "Unable to connect to database: $DBI::errstr"; + +my $where_label = defined $label ? "AND warpRun.label = '$label'" : ""; # WHERE for label + +my $sql = " +-- Get a list of exposures on which magic may be performed +SELECT + rawExp.exp_id, + MAX(warpRun.warp_id) AS warp_id, + -- The following trick pulls out the 'zpt_obs' value for the maximum warp_id + SUBSTRING_INDEX(GROUP_CONCAT(camProcessedExp.zpt_obs ORDER BY warpRun.warp_id), ',', 1) AS zpt_obs +FROM warpRun +JOIN fakeRun USING(fake_id) +JOIN camRun USING(cam_id) +JOIN camProcessedExp USING(cam_id) +JOIN chipRun USING(chip_id) +JOIN rawExp USING(exp_id) +WHERE rawExp.camera = '$camera' + AND warpRun.state = 'full' + $where_label +GROUP BY exp_id;"; + +my $warps = $db->selectall_arrayref( $sql, { Slice => {} } ) or die "Unable to execute SQL: $DBI::errstr"; + +print "Selected " . scalar @$warps . " rows.\n"; + +$ipprc->outroot_prepare( $outroot ); +my $outrootResolved = $ipprc->file_resolve( $outroot ); +my ($dsFile, $dsName) = tempfile( "$outrootResolved.dslist.XXXX", UNLINK => !$save_temps); + +foreach my $warp ( @$warps ) { + my $exp_id = $warp->{exp_id}; + my $zp = $warp->{zpt_obs}; + my $warp_id = $warp->{warp_id}; + + my $sql = "SELECT * FROM warpSkyfile WHERE warp_id = $warp_id AND fault = 0 AND quality = 0;"; + my $skycells = $db->selectall_arrayref( $sql, { Slice => {} } ) or die "Unable to execute SQL: $DBI::errstr"; + + foreach my $skycell ( @$skycells ) { + my $skycell_id = $skycell->{skycell_id}; + my $path_base = $skycell->{path_base}; + + my $input = $ipprc->filename("PSPHOT.OUT.CMF.MEF", $path_base); + (carp "Can't find $input\n" and next) unless $ipprc->file_exists($input); + $input = $ipprc->file_resolve($input); + + my $output = caturi( $outroot, "mops.$exp_id.$skycell_id.$warp_id.fits" ); + $output = $ipprc->file_resolve($output); + + unless ($no_op) { + $ipprc->file_prepare($output); + my $command = "$ppmops $input $zp $output"; + my $success = run( command => $command, verbose => $verbose ); + (carp "Couldn't translate $input\n" and next) unless $success; + } + + # format: filename|filesize|md5sum|filetype| + # note: since we omit filesize and md5sum, dsreg will calculate them + print $dsFile "${output}|||ipp-mops|\n"; + } +} +close $dsFile; +$db->disconnect; + +# Register new files with the data store +unless ($no_update) { + my $command = "$dsreg --add $fileset --product mops_transient_detections --type MOPS_TRANSIENT_DETECTIONS --list $dsName --copy --abspath --dbname DataStore"; + my $success = run( command => $command, verbose => $verbose ); + die "Couldn't register files with data store.\n" unless $success; +} + + +__END__ + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_register.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_register.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_register.pl (revision 41105) @@ -0,0 +1,118 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($dbname, # Database name to use + ); +GetOptions( + 'dbname|d=s' => \$dbname, +) or pod2usage( 2 ); + +pod2usage( + -msg => "Required options: --dbname", + -exitval => 3, + ) unless defined $dbname; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser + +# Look for programs we need +my $missing_tools; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $register_imfile = can_run('register_imfile.pl') or (warn "Can't find register_imfile.pl" and $missing_tools = 1); +my $register_exp = can_run('register_exp.pl') or (warn "Can't find register_exp.pl" and $missing_tools = 1); +die "Can't find required tools.\n" if $missing_tools; + +# Phase 0 imfile processing +{ + my $command = "$regtool -pendingimfile -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get phase 0 imfile list: $error_code\n" if not $success; + + my @whole = split /\n/, join( '', @$stdout_buf ); + my @single = (); + + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ) or + die "Unable to parse output from regtool.\n"; + + foreach my $item (@$list) { + my $exp_id = $item->{exp_id}; + my $exp_name = $item->{tmp_exp_name}; + my $class_id = $item->{tmp_class_id}; + my $uri = $item->{uri}; + + my $command = "$register_imfile --exp_id $exp_id --tmp_class_id $class_id --tmp_exp_name $exp_name --uri $uri --dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do phase 0 imfile processing on $exp_name $class_id: $error_code\n" if not $success; + } + + + @single = (); + + } + } +} + +# Phase 0 exposure processing +{ + my $command = "$regtool -pendingexp -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get phase 0 exposure list: $error_code\n" if not $success; + + my @whole = split /\n/, join( '', @$stdout_buf ); + my @single = (); + + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ) or + die "Unable to parse output from regtool.\n"; + + foreach my $item (@$list) { + my $exp_tag = $item->{tmp_exp_name} . '.' . $item->{exp_id}; + my $exp_id = $item->{exp_id}; + + my $command = "$register_exp --exp_tag $exp_tag --exp_id $exp_id --dbname $dbname"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do phase 0 exposure processing on $exp_tag: $error_code\n" if not $success; + } + + @single = (); + + } + } +} + + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_stack.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_stack.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_stack.pl (revision 41105) @@ -0,0 +1,99 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use File::Basename; + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +my ($dbname, # Database name to use + $verbose, # Verbose operations? + $workdir_global, # Global working directory + $no_op, # No operations? + $no_update, # No updating? + $save_temps, # Save temporary files? + ); +GetOptions( + 'dbname=s' => \$dbname, + 'verbose' => \$verbose, + 'workdir' => \$workdir_global, + 'no-op' => \$no_op, + 'no-update' => \$no_update, + 'save-temps' => \$save_temps, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "Required options: --dbname", + -exitval => 3, + ) unless defined $dbname; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser + +# Look for programs we need +my $missing_tools; +my $stacktool = can_run('stacktool') or + (warn "Can't find difftool" and $missing_tools = 1); +my $stack_skycell = can_run('stack_skycell.pl') or + (warn "Can't find stack_skycell.pl" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + + +# Image stacking +{ + my $list; + my $command = "$stacktool -tosum -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get list of stacks: $error_code\n" if not $success; + $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from stacktool.\n"; + + foreach my $item (@$list) { + my $stack_id = $item->{stack_id}; + my $workdir = $item->{workdir}; + my $tess_id = basename($item->{tess_id}); + my $skycell_id = $item->{skycell_id}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, $tess_id, $skycell_id, "$tess_id.$skycell_id.stk.$stack_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$stack_skycell --stack_id $stack_id --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + $command .= " --save-temps" if defined $save_temps; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); +### die "Unable to do stack for $stack_id: $error_code\n" if not $success; + } +} + + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_warp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_warp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_serial_warp.pl (revision 41105) @@ -0,0 +1,129 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use File::Basename; + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +my ($dbname, # Database name to use + $verbose, # Verbose operations? + $workdir_global, # Global working directory + $no_op, # No operations? + $no_update, # No updating? + ); +GetOptions( + 'dbname=s' => \$dbname, + 'verbose' => \$verbose, + 'workdir' => \$workdir_global, + 'no-op' => \$no_op, + 'no-update' => \$no_update, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "Required options: --dbname", + -exitval => 3, + ) unless defined $dbname; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Metadata config parser + +# Look for programs we need +my $missing_tools; +my $warptool = can_run('warptool') or + (warn "Can't find warptool" and $missing_tools = 1); +my $warp_skycell = can_run('warp_skycell.pl') or + (warn "Can't find warp_skycell.pl" and $missing_tools = 1); +my $warp_overlap = can_run('warp_overlap.pl') or + (warn "Can't find warp_overlap.pl" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + + +# Calculate overlaps +{ + my $list; + my $command = "$warptool -tooverlap -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get warps for which to calculate overlaps: $error_code\n" if not $success; + $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from warptool.\n"; + + foreach my $item (@$list) { + my $warp_id = $item->{warp_id}; + my $cam_id = $item->{cam_id}; + my $workdir = $item->{workdir}; + my $camera = $item->{camera}; + my $tess_id = $item->{tess_id}; + + my $command = "$warp_overlap --warp_id $warp_id --camera $camera --tess_id $tess_id --dbname $dbname"; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get warp overlaps on $warp_id: $error_code\n" if not $success; + } +} + + +# Warping proper +{ + my $list; + my $command = "$warptool -towarped -dbname $dbname"; # Command to run + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to get warps for warping: $error_code\n" if not $success; + $list = parse_md_list( $mdcParser->parse( join( '', @$stdout_buf ) ) ) or + die "Unable to parse output from warptool.\n"; + + foreach my $item (@$list) { + my $warp_id = $item->{warp_id}; + my $skycell_id = $item->{skycell_id}; + my $tess_id = basename($item->{tess_id}); + my $cam_id = $item->{cam_id}; + my $workdir = $item->{workdir}; + my $camera = $item->{camera}; + + $workdir = $workdir_global unless defined $workdir and $workdir ne "NULL"; + die "No working directory specified.\n" unless defined $workdir; + + my $outroot = caturi( $workdir, $tess_id, $skycell_id, "$tess_id.$skycell_id.wrp.$warp_id" ); + $ipprc->outroot_prepare( $outroot ); + + my $command = "$warp_skycell --warp_id $warp_id --skycell_id $skycell_id --tess_id $tess_id --camera $camera --dbname $dbname --outroot $outroot"; + $command .= " --verbose" if defined $verbose; + $command .= " --no-op" if defined $no_op; + $command .= " --no-update" if defined $no_update; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run( command => $command, verbose => 1 ); + die "Unable to do warp processing on $warp_id,$skycell_id: $error_code\n" if not $success; + } +} + + + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_simulation_data.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_simulation_data.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipp_simulation_data.pl (revision 41105) @@ -0,0 +1,215 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use Math::Trig; +use File::Spec; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +my ($name, # Base name for output images + $camera, # Name of camera to use + $telescope, # Telescope name + $tess_id, # Tessellation identifier + $dbname, # Database name + $path, # Path to data + $workdir, # Working directory for data + $no_cal, # Don't produce calibration files + $no_update # Don't update the database + ); + +GetOptions( + 'name=s' => \$name, + 'camera=s' => \$camera, + 'telescope=s' => \$telescope, + 'tess_id=s' => \$tess_id, + 'dbname=s' => \$dbname, + 'path=s' => \$path, + 'workdir=s' => \$workdir, + 'no-cal' => \$no_cal, + 'no-update' => \$no_update, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "Required options: --name --path --camera --telescope --dbname", + -exitval => 3, + ) unless + defined $name and + defined $path and + defined $camera and + defined $telescope and + defined $dbname; + +$workdir = $path if not defined $workdir; + +# Look for programs we need +my $missing_tools; +my $ppSim = can_run('ppSim') + or (warn "Can't find ppSim" and $missing_tools = 1); +my $inject = can_run('ipp_serial_inject_mosaic.pl') + or (warn "Can't find ipp_serial_inject_mosaic.pl" and $missing_tools = 1); + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Number of bias images +use constant BIAS => 20; +# Dark exposure times +use constant DARK => [ 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, + 300, 300, 300, 300, 300, 300, 300, 300, 300, 300 ]; +# Flat-field image characteristics +use constant FLAT => [ + { + filter => 'r', + exptime => [ 0.1, 0.1, 0.1, 0.1, 0.1, 0.5, 1, 2, 5, 10, 20, 20, 20, 20, 20 ], + }, + { + filter => 'i', + exptime => [ 20, 20, 20, 20, 20 ], + } + ]; +# Object image characteristics +use constant OBJECT => [ + { + filter => 'r', + exptime => [ 5, 10, 10, 10, 10, 10, 240 ], + seeing => [ 0.8, 0.4, 0.6, 0.8, 1.2, 1.5, 0.7 ], + ra => 150.119167, + dec => 2.205833, + pa => 0, + zp => 25.15, + sky => 20.86, + dither => 40, + }, + { + filter => 'i', + exptime => [ 5, 30, 30, 30, 30, 30, 240 ], + seeing => [ 0.8, 0.4, 0.6, 0.8, 1.2, 1.5, 0.7 ], + ra => 150.119167, + dec => 2.205833, + pa => 0, + zp => 25.00, + sky => 20.15, + dither => 40, + }, + ]; +use constant SCALE => 0.2; # Plate scale + +############################################################################################################# +### Now do the work +############################################################################################################# + +my $counter = 0; +my $tessellation = (defined $tess_id) ? "--tess_id $tess_id" : ""; # Additional switch for tessellation + +# Generate bias images +for (my $i = 0; $i < BIAS; $i++) { + my $basename; # Output base filename + ( $basename, $counter ) = filename( $name, $counter ); + my $filename = caturi( $path, $basename ); + unless ($no_cal) { + run( command => "$ppSim -camera $camera -type BIAS $filename", + verbose => 1 ) or die "Unable to run ppSim"; + unless ($no_update) { + run( command => "$inject --camera $camera --telescope $telescope --path $path " . + "$tessellation --workdir $workdir --dbname $dbname $basename", + verbose => 1 ) or die "Unable to inject file."; + } + } +} + +# Generate dark images +foreach my $exptime ( @{DARK()} ) { + my $basename; # Output base filename + ( $basename, $counter ) = filename( $name, $counter ); + my $filename = caturi( $path, $basename ); + unless ($no_cal) { + run ( command => "$ppSim -camera $camera -type DARK -exptime $exptime $filename", + verbose => 1 ) or die "Unable to run ppSim"; + unless ($no_update) { + run( command => "$inject --camera $camera --telescope $telescope --path $path " . + "$tessellation --workdir $workdir --dbname $dbname $basename", + verbose => 1 ) or die "Unable to inject file."; + } + } +} + +# Generate flat images +foreach my $set ( @{FLAT()} ) { + my $filter = $set->{filter}; # Name of filter + foreach my $exptime ( @{$set->{exptime}} ) { + my $basename; # Output base filename + ( $basename, $counter ) = filename( $name, $counter ); + my $filename = caturi( $path, $basename ); + unless ($no_cal) { + run( command => "$ppSim -camera $camera -type FLAT -filter $filter -exptime $exptime $filename", + verbose => 1 ) or die "Unable to run ppSim"; + unless ($no_update) { + run( command => "$inject --camera $camera --telescope $telescope --path $path " . + "$tessellation --workdir $workdir --dbname $dbname $basename", + verbose => 1 ) or die "Unable to inject file."; + } + } + } +} + +# Generate object images +foreach my $set ( @{OBJECT()} ) { + my $filter = $set->{filter}; # Name of filter + my $ra0 = $set->{ra}; # Base Right Ascension (deg) + my $dec0 = $set->{dec}; # Base Declination (deg) + my $pa = $set->{pa}; # Position angle (deg) + my $zp = $set->{zp}; # Zero point + my $scale = SCALE(); # Plate scale (arcsec/pix) + my $sky = 10**( -0.4 * ( $set->{sky} - $zp ) ) * $scale**2; # Sky background (counts/s) + my $dither = $set->{dither} / 3600; # Dither size (deg) + + for (my $i = 0; $i < scalar @{$set->{exptime}}; $i++) { + my $exptime = ${$set->{exptime}}[$i]; # Exposure time + my $seeing = ${$set->{seeing}}[$i]; # Seeing (pix) + my $ra = $ra0 + (2*rand() - 1) * $dither * cos(deg2rad($dec0)); # RA with dither + my $dec = $dec0 + (2*rand() - 1) * $dither; # Dec with dither + + my $basename; # Output base filename + ( $basename, $counter ) = filename( $name, $counter ); + my $filename = caturi( $path, $basename ); + run( command => "$ppSim -camera $camera -type OBJECT -filter $filter -exptime $exptime " . + "-skyrate $sky -ra $ra -dec $dec -pa $pa -scale $scale -zp $zp -seeing $seeing $filename", + verbose => 1 ) or die "Unable to run ppSim"; + unless ($no_update) { + run( command => "$inject --camera $camera --telescope $telescope --path $path " . + "$tessellation --workdir $workdir --dbname $dbname $basename", + verbose => 1 ) or die "Unable to inject file."; + } + } +} + + +### Pau. + + +# Generate a filename from the base name and counter +sub filename +{ + my $base = shift; # Base name + my $num = shift; # Number + my $workdir = shift; # Working directory + my $name = sprintf("$base%04d", $num); + $num++; + return ( $name, $num ); +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ippdb.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ippdb.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ippdb.pl (revision 41105) @@ -0,0 +1,79 @@ +#!/usr/bin/env perl + +# tool to lookup ipp database IDs from the ippadbmin database + +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use DBI; +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +my ($dbname, $list, $help); + +GetOptions( + 'dbname|d=s' => \$dbname, # Database name + 'list' => \$list, + 'help' => \$help, +) or pod2usage( 2 ); + +pod2usage( -msg => "USAGE: ippdb.pl [--dbname dbname]", -exitval => 2 ) if defined $help; +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "either --dbname (dbname) or --list is required", -exitval => 3) unless defined $dbname or defined $list; + +my $ipprc = PS::IPP::Config->new(); +my $dbh = getDBHandle(); + +# Get the list of imfiles +{ + my $query; + + if ($list) { + $query = "SELECT * FROM projects"; + my $stmt = $dbh->prepare($query); + $stmt->execute(); + print STDOUT "proj_id : projname\n"; + while (my $ref = $stmt->fetchrow_hashref()) { + printf STDOUT "%7s : %s\n", $ref->{proj_id}, $ref->{projname}; + } + exit 0; + } + + $query = "SELECT proj_id FROM projects WHERE projname = \'$dbname\'"; + my $stmt = $dbh->prepare($query); + $stmt->execute(); + my $ref = $stmt->fetchrow_hashref(); + if (!$ref) { + print STDERR "ippdb $dbname not found\n"; + exit 1; + } + + my $proj_id = $ref->{proj_id}; + print STDOUT "$proj_id\n"; + + $stmt->finish(); + exit 0; +} + +sub getDBHandle { + my $dbserver = metadataLookupStr($ipprc->{_siteConfig}, "DBSERVER"); + my $dbuser = metadataLookupStr($ipprc->{_siteConfig}, "DBUSER"); + my $dbpassword = metadataLookupStr($ipprc->{_siteConfig}, "DBPASSWORD"); + my $admindb = "ippadmin"; + + die "database configuration set up" unless defined($dbserver); + die "database configuration set up" unless defined($dbuser); + die "database configuration set up" unless defined($dbpassword); + + my $dsn = "DBI:mysql:host=$dbserver;database=$admindb"; + my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) or die "Cannot connect to database.\n"; + + return $dbh; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipprc.txt =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipprc.txt (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/ipprc.txt (revision 41105) @@ -0,0 +1,16 @@ + +these scripts use the following library functions to work with the IPP Config system: + +$ipprc->convert_filename_absolute( $tess_dir ); +$ipprc->convert_filename_relative( $absfile ); +$ipprc->define_camera($camera); +$ipprc->extname_rule("CMF.HEAD", $class_id); # MEF psastro output +$ipprc->file_create_append( $logName ); +$ipprc->file_exists( $skyfile ); +$ipprc->file_prepare( "$exp_tag/$exp_tag.detproc.$det_id", $workdir, $input_uri ); +$ipprc->file_resolve ($path_base); +$ipprc->filename( "PPIMAGE.BIN1", $file->{path_base}, $file->{class_id} ) . "\n"); +$ipprc->outroot_prepare($outroot); +$ipprc->reduction($reduction, 'JPEG_BIN1_IMAGE_' . uc($det_type)); # Recipe to use +$ipprc->rejection( $name, $det_type, $filter ); +$ipprc->tessellation_catdir( $tess_id ); # Tessellation catdir for DVO Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/isp_trans.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/isp_trans.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/isp_trans.pl (revision 41105) @@ -0,0 +1,30 @@ +#!/usr/bin/env perl +# basic ISP transmission analysis: + +if (@ARGV != 1) { die "USAGE: isp_trans.pl (input.fits)\n"; } +$input = $ARGV[0]; + +# for input file /path/foo.fits, use /path/foo for output + +@words = split ('\.', $input); +if (@words > 1) { pop @words; } +$output = join (".", @words); + +# use constant RECIPE => 'PPIMAGE_OBDSFRA'; # Recipe to use +$RECIPE_PPIMAGE = 'PPIMAGE_OA'; # Recipe to use (switch to OBDSFRA when detrend images are ready) +$RECIPE_PSPHOT = 'PSPHOT.SUMMIT'; +$CALDIR = '/data/alala.0/ipp/ippRefs/catdir.synth.bright'; # source of photometric calibration data +$IMTABLE = 'images.dat'; # source of photometric calibration data + +vsystem ("ppImage -file $input $output -recipe PPIMAGE $RECIPE_PPIMAGE -recipe PSPHOT $RECIPE_PSPHOT"); +if ($status) { die "failure running ppImage\n"; } + +vsystem ("addstar -incal -image -D CAMERA isp -D IMAGE_TABLE $IMTABLE -D CATDIR $CALDIR $output.smf"); +if ($status) { die "failure getting calibration from addstar\n"; } + +sub vsystem { + print STDERR "@_\n"; + my $status = system ("@_"); + $status; +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lap_queue_diff.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lap_queue_diff.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lap_queue_diff.pl (revision 41105) @@ -0,0 +1,317 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use DateTime; + + +my $missing_tools = 0; + +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $laptool = can_run('laptool') or (warn "Can't find laptool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + + +my ( $help, $verbose, $debug, $do_nothing); +my ( $camera, $dbname); +my ( $lap_id, $data_group ); +my ( $queue_list ); + +GetOptions( + 'help|h' => \$help, + 'verbose' => \$verbose, + 'debug' => \$debug, + 'do_nothing' => \$do_nothing, + + 'camera=s' => \$camera, + 'dbname=s' => \$dbname, + + 'lap_id=s' => \$lap_id, + 'data_group=s' => \$data_group, + 'queue_list=s' => \$queue_list, + ) or pod2usage ( 2 ); +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "--lap_id --data_group --queue_list are required", + -exitval => 3, + ) unless + defined $lap_id and + defined $queue_list and + defined $data_group +; + +unless (defined $dbname) { + $dbname = 'gpc1'; +} + +my $mdcParser = PS::IPP::Metadata::Config->new; + +log_message("Startup"); + +my %lapRunInfo = get_lapRun_info($lap_id); +unless (($lapRunInfo{state} eq 'full')|| + ($lapRunInfo{state} eq 'done')) { + &my_die("Cannot run diff_mode if lapRun != full!", $lap_id); +} +my $label = $lapRunInfo{label}; +log_message("Have lapRun info"); + +my %projcell_done = (); +&get_completed_projcells($label); +log_message("Have completed projcells"); + +my %projcell_todo = (); +&get_projcell_set(); +log_message("Have projcells todo"); + +my $Nexp = 0; +my $Ndiff= 0; +my $lapExp = get_lapExp_info($lap_id); +foreach my $exp (@{ $lapExp }) { + log_message(" Exp " . $exp->{exp_id}); + $Nexp++; + if ($exp->{data_state} eq 'full') { + my $warp_id = get_warp_id($exp->{exp_id},$exp->{chip_id}); + my @warp_proj_cells = get_warp_projcells($warp_id); + my $can_diff = check_diff_existance($warp_id,$label); + if ($can_diff) { + foreach my $pc (@warp_proj_cells) { + if (exists($projcell_todo{$pc})) { # We plan on doing this projection cell + unless (exists($projcell_done{$pc})) { # But we haven't done it? + $can_diff = 0; + } + } + } + if ($can_diff == 1) { + # This needs a check to ensure it hasn't been done yet. + my $diff_id = &launch_diff($warp_id,$label,$data_group); + print "Made diff for $warp_id => $diff_id\n"; + $Ndiff++; + } + } + log_message(" Diff? $can_diff"); + } +} +print "LAP_ID: $lap_id\n"; +print "NEXP: $Nexp\n"; +print "NDIFF: $Ndiff\n"; + + + +sub log_message { + my $message = shift; + if ($verbose) { + print "$message\n"; + } +} + +sub get_lapRun_info { + my $lap_id = shift; + my $command = "$laptool -pendingrun -lap_id $lap_id"; + $command .= " -dbname $dbname " if defined $dbname; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -pendingrun: $error_code", $lap_id); + } + my $Runs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -pendingrun", $lap_id); + # There should be only one. + my $Run = ${ $Runs }[0]; + my %info = %{ $Run }; + return(%info); +} + +sub get_lapExp_info { + my $lap_id = shift; + my $command = "$laptool -exposures -lap_id $lap_id"; + $command .= " -dbname $dbname" if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -exposures: $error_code", $lap_id); + } + + if (@$stdout_buf == 0) { + # Nothing to do. However, this is likely an error. + return(0); + } + + my $exposures = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -exposures", $lap_id); + return($exposures); # This is a pointer to an array of hashes. +} + +sub get_completed_projcells { + my $label = shift; + my $command = "$laptool -listrun -label ${label} -state done "; + $command .= " -dbname $dbname " if defined $dbname; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -pendingrun: $error_code", $lap_id); + } + my $Runs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -pendingrun", $lap_id); + foreach my $r (@{ $Runs }) { + $projcell_done{$r->{projection_cell}} = 1; + } +} + +sub get_projcell_set { + open(Q,$queue_list) or &my_die("Cannot open queue list $queue_list",$lap_id); + while() { + chomp; + my $cmd = $_; + my $projection_cell = $cmd; + $projection_cell =~ s/.*?-projection_cell (skycell.\w+?) .*/$1/; + $projcell_todo{$projection_cell} = 1; + } + close(Q); +} + +sub get_warp_id { + my $exp_id = shift; + my $chip_id = shift; + + my $warptool_info_cmd = "$warptool -listrun -exp_id $exp_id -chip_id $chip_id"; + $warptool_info_cmd .= " -dbname $dbname " if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $warptool_info_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool -listrun: $error_code", $exp_id); + } + my $warps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from warptool -listrun", $exp_id); + # There should be only one. + my $warp = ${ $warps }[0]; + my $warp_id = 0; + if ($warp) { + $warp_id = $warp->{warp_id}; + } + if ($warp_id == 0) { + &my_die("Unable to find warp_id",$exp_id); + } + return($warp_id); +} + + +sub get_warp_projcells { + my $warp_id = shift; + my %proj_cell_list = (); + my $command = "$warptool -warped -warp_id ${warp_id}"; + $command .= " -dbname $dbname " if defined $dbname; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -pendingrun: $error_code", $lap_id); + } + my $Runs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -pendingrun", $lap_id); + foreach my $r (@{ $Runs }) { + my $projcell = $r->{skycell_id}; + $projcell =~ s/\.\d\d\d$//; + $proj_cell_list{$projcell} = 1; + } + return(keys(%proj_cell_list)); +} + +sub check_diff_existance { + my $warp_id = shift; + my $label = shift; + my $command = "$difftool -listrun -warp_id ${warp_id} -label ${label}"; + $command .= " -dbname $dbname " if defined $dbname; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -pendingrun: $error_code", $lap_id); + } + my $Runs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -pendingrun", $lap_id); + my $N = $#{ $Runs } + 1; + if ($N == 0) { + return(1); + } + else { + return(0); + } +} + +sub launch_diff { + my $warp_id = shift; + my $label = shift; + my $data_group = shift; + my $command = "$difftool -definewarpstack -available -bothways -good_frac 0.2 "; + $command .= " -warp_label $label -stack_label $label -set_label $label "; + $command .= " -set_data_group $data_group "; + $command .= " -set_workdir neb://\@HOST\@.0/gpc1/${label}/${data_group}/ "; + $command .= " -set_reduction WARPSTACK_PV3 "; + $command .= " -warp_id ${warp_id} "; + $command .= " -dbname $dbname " if defined $dbname; + + if (($debug)||($do_nothing)) { + print "DEBUG! WOULD RUN: >> $command\n"; + return(99); + } + else { + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -pendingrun: $error_code", $lap_id); + } + my $Runs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -pendingrun", $lap_id); + if ($#{ $Runs } != 0) { + print "Something has gone seriously wrong, and we've made more than one diff for warp_id $warp_id\n"; + } + my $Run = ${ $Runs }[0]; + my $diff_id = $Run->{diff_id}; + return($diff_id); + } +} + +# +# Utilities +################################################################################ + +sub my_die { + my $msg = shift; # Warning message on die + my $lap_id = shift; # identifier + my $optional = shift; + my $exit_code = shift; + unless (defined $exit_code) { + $exit_code = $PS_EXIT_PROG_ERROR; + } + carp($msg); + exit $exit_code; +} + +# Check to see if a 64bit integer is NULL or not. This is probably fragile, but I don't know how to get a S64 NULL out. +sub S64_IS_NOT_NULL { + if ($_[0] == 9223372036854775807) { + return(0); + } + else { + return(1); + } +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lap_science.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lap_science.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lap_science.pl (revision 41105) @@ -0,0 +1,1643 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use DateTime; + +# +# Set up +################################################################################ + +my $missing_tools = 0; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +my $laptool = can_run('laptool') or (warn "Can't find laptool" and $missing_tools = 1); + +my ( $help, $verbose, $debug, $do_nothing); +my ( $camera, $dbname); +my ( $lap_id ); +my ( $queue_list ); +my ( $chip_mode, $monitor_mode, $cleanup_mode); + +# +# Global configuration constants that probably should be read from elsewhere. +my $qstack_threshold = 0.05; # Only make a quickstack if more than 5% of the exposures require it. +my $minimum_stack_inputs = 2; # We can avoid magicking stack inputs if we have more than this number. +my $maximum_stack_inputs = 25; # This is the place-holder guess on how big a stack we should process locally. 25 is the best guess. +my $do_updates_pv2 = 0; # Do updates using the calls needed for PV2. + +GetOptions( + 'help|h' => \$help, + 'verbose' => \$verbose, + 'debug' => \$debug, + 'do_nothing' => \$do_nothing, + + 'camera=s' => \$camera, + 'dbname=s' => \$dbname, + + 'lap_id=s' => \$lap_id, + 'queue_list=s' => \$queue_list, + + 'chip_mode' => \$chip_mode, + 'monitor_mode' => \$monitor_mode, + 'cleanup_mode' => \$cleanup_mode, + ) or pod2usage ( 2 ); +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Choose a mode: --chip_mode --monitor_mode --cleanup_mode", + -exitval => 3, + ) unless + defined $chip_mode or defined $monitor_mode or defined $cleanup_mode; +pod2usage( + -msg => "--lap_id is required", + -exitval => 3, + ) unless + defined $lap_id; + +unless (defined $dbname) { + $dbname = 'gpc1'; +} + +my $mdcParser = PS::IPP::Metadata::Config->new; + +# Fetch all the information about this run +my %lapRunInfo = get_lapRun_info($lap_id); + +# Run the appropriate mode + +if (defined($chip_mode)) { + unless ($lapRunInfo{state} eq 'new') { + &my_die("Cannot run chip_mode if lapRun.state != new!",$lap_id); + } + my $status = chip_mode($lap_id); + exit $status; +} +if (defined($monitor_mode)) { + unless ($lapRunInfo{state} eq 'run') { + &my_die("Cannot run monitor_mode if lapRun != run!", $lap_id); + } + my $status = monitor_mode($lap_id); + exit $status; +} +if (defined($cleanup_mode)) { + unless (($lapRunInfo{state} eq 'full')|| + ($lapRunInfo{state} eq 'drop')) { + &my_die("Cannot run cleanup_mode if lapRun != full!", $lap_id); + } + my $status = cleanup_mode($lap_id); + exit $status; +} + +# +# Chip +################################################################################ + +sub chip_mode { + my $lap_id = shift; + my $status = queue_chips($lap_id); + + if (!$status) { # This is the culprit. + my $command = "$laptool -updaterun -lap_id $lap_id"; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -set_state run "; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updaterun: $error_code", $lap_id); + } + } + return($status); +} + +# retrieve the chip_id for the exposure inserted +sub get_chip_id_from_metadata { + my $exp_id = shift; + my $label = shift; + my $data_group = shift; + # This is a puzzler... chiptool doesn't actually return a useful metadata. We'll just scrape it from the database for now. + + my $command = "$chiptool -listrun -pstamp_order -exp_id $exp_id -label $label -data_group $data_group"; + $command .= " -dbname $dbname " if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool -listrun: $error_code", $exp_id, $data_group); + } + my $chips = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from chiptool -listrun", $exp_id, $data_group); + # There should be only one. + my $chip = ${ $chips }[0]; + my $chip_id = 0; + if ($chip) { + $chip_id = $chip->{chip_id}; + } + + return($chip_id); +} + +sub get_lapRun_info { + my $lap_id = shift; + my $command = "$laptool -pendingrun -lap_id $lap_id"; + $command .= " -dbname $dbname " if defined $dbname; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -pendingrun: $error_code", $lap_id); + } + my $Runs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -pendingrun", $lap_id); + # There should be only one. + my $Run = ${ $Runs }[0]; + my %info = %{ $Run }; + return(%info); +} + + +# Queue a chipRun for this exposure with the appropriate parameters. +sub remake_this_exposure { + my $exposure = shift; + + my @utctime = gmtime(); + $utctime[5] += 1900; + $utctime[4] += 1; + + my $label = $exposure->{label}; + + my $date = sprintf("%4d%02d%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir_date = sprintf("%4d/%02d/%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir = "neb://\@HOST\@.0/${dbname}/${label}/${workdir_date}"; + my $data_group = "${label}.${date}"; + + + my $chip_cmd = "$chiptool"; + $chip_cmd .= " -pretend " if defined $debug; + $chip_cmd .= " -dbname $dbname " if defined $dbname; + $chip_cmd .= " -definebyquery -exp_id $exposure->{exp_id} -set_end_stage warp -set_tess_id $exposure->{tess_id} "; + $chip_cmd .= " -set_label $exposure->{label} -set_data_group $data_group "; + $chip_cmd .= " -set_workdir $workdir -set_dist_group $exposure->{dist_group} "; + $chip_cmd .= " -set_reduction LAP_SCIENCE "; +# $chip_cmd .= " -set_reduction LAP_POLE "; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $chip_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool -definebyquery: $error_code", $exposure->{lap_id}, $exposure->{proj_cell}); + } + + $exposure->{chip_id} = get_chip_id_from_metadata($exposure->{exp_id},$exposure->{label},$data_group); + $exposure->{data_state} = 'new'; + update_this_exposure($exposure); + return($exposure); +} + +sub remake_this_exposure_by_update { + my $exposure = shift; + + my @utctime = gmtime(); + $utctime[5] += 1900; + $utctime[4] += 1; + + my $label = $exposure->{label}; + + my $date = sprintf("%4d%02d%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir_date = sprintf("%4d/%02d/%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir = "neb://\@HOST\@.0/${dbname}/${label}/${workdir_date}"; + my $data_group = "${label}.${date}"; + + my $chiptool_info_cmd = "chiptool -listrun -exp_id $exposure->{exp_id} -chip_id $exposure->{chip_id} "; + $chiptool_info_cmd .= " -dbname $dbname " if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $chiptool_info_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool -listrun: $error_code", $exposure->{exp_id}, $data_group); + } + my $chips = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from chiptool -listrun", $exposure->{exp_id}, $data_group); + # There should be only one. + my $chip = ${ $chips }[0]; + my $chip_magicDS_id = 0; + my $chip_cam_id = 0; + if ($chip) { + $chip_magicDS_id = $chip->{magic_ds_id}; + $chip_cam_id = $chip->{cam_id}; + } + if ($chip_magicDS_id == 0) { +# return(&remake_this_exposure($exposure)); + } + + my $do_cam_update = 0; + if ($chip_cam_id) { # If there is no cam_id, we can't look for it. + my $camtool_info_cmd = "camtool -processedexp -cam_id $chip_cam_id "; + $camtool_info_cmd .= " -dbname $dbname " if defined $dbname; + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $camtool_info_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool -listrun: $error_code", $exposure->{exp_id}, $data_group); + } + my $cams = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from camtool -listrun", $exposure->{exp_id}, $data_group); + my $cam = ${ $cams }[0]; + # There can be only one. + if ($cam) { + if ($cam->{label} ne $label) { + $do_cam_update = 1; + } + } + } + + my $warptool_info_cmd = "warptool -listrun -exp_id $exposure->{exp_id} -chip_id $exposure->{chip_id} "; + $warptool_info_cmd .= " -dbname $dbname " if defined $dbname; + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $warptool_info_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool -listrun: $error_code", $exposure->{exp_id}, $data_group); + } + my $warps = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from warptool -listrun", $exposure->{exp_id}, $data_group); + # There should be only one. + my $warp = ${ $warps }[0]; + my $warp_id = 0; + if ($warp) { + $warp_id = $warp->{warp_id}; + } + else { + $exposure->{data_state} = 'drop'; + return($exposure); + } + if ($warp_id == 0) { + # Handle this correctly. Probably want to drop the exposure here. + $exposure->{data_state} = 'drop'; + return($exposure); + } + + if (($chip->{state} eq 'goto_cleaned')|| + ($warp->{state} eq 'goto_cleaned')|| + ($chip->{dsRun_state} eq 'goto_cleaned')) { + $exposure->{data_state} = 'pending_update'; + &update_this_exposure($exposure); + return($exposure); + } + +# +# This is where we launch updates. +# + + my $chiptool_update_cmd = "chiptool -setimfiletoupdate -chip_id $exposure->{chip_id} -set_label $label"; + if ($do_updates_pv2) { + $chiptool_update_cmd .= " -set_update_mode 1 "; # Use the current config information + } + $chiptool_update_cmd .= " -dbname $dbname " if defined $dbname; + my $camtool_update_cmd .= "camtool -updaterun -set_state update -cam_id $chip_cam_id -set_label $label"; + $camtool_update_cmd .= " -dbname $dbname " if defined $dbname; + my $magicDS_update_cmd = "magicdstool -setfiletoupdate -magic_ds_id $chip_magicDS_id -set_label $label"; + $magicDS_update_cmd .= " -dbname $dbname " if defined $dbname; + my $warptool_preupdate_cmd = "warptool -revertwarped -warp_id $warp_id -fault 26"; + $warptool_preupdate_cmd .= " -dbname $dbname " if defined $dbname; + my $warptool_update_cmd = "warptool -setskyfiletoupdate -warp_id $warp_id -set_label $label"; + $warptool_update_cmd .= " -dbname $dbname " if defined $dbname; + + # only need to update the data if the warps are not full + if ($warp->{state} ne 'full') { + if (($chip->{state} eq 'cleaned')|| # Exposure is cleaned + (($chip->{state} eq 'update')&&($chip->{label} ne $label))) { # Exposure is owned by an interloper. + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $chiptool_update_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool -setimfiletoupdate: $error_code", $exposure->{exp_id}, $data_group); + } + if ($do_updates_pv2) { # Are we updating camera stages for PV2? + if ($do_cam_update) { # Is this camRun still set to the old label? + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $camtool_update_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool -updaterun: $error_code", $exposure->{exp_id}, $data_group); + } + } + } +# if ($chip_magicDS_id != 0) { +# ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run(command => $magicDS_update_cmd, verbose => $verbose); +# unless ($success) { +# $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); +# &my_die("Unable to perform magicdstool -setfiletoupdate: $error_code", $exposure->{exp_id}, $data_group); +# } +# } + } + + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $warptool_preupdate_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool --revertwarped: $error_code", $exposure->{exp_id}, $data_group); + } + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $warptool_update_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool -setskyfiletoupdate: $error_code", $exposure->{exp_id}, $data_group); + } + } + $exposure->{active} = 1; + + return($exposure); +} + +sub determine_if_can_update { + my $exposure = shift; + + if (S64_IS_NOT_NULL($exposure->{warp_id})) { + if ($exposure->{warpRun_state} eq 'full') { + # this warp is in full state no need to update it or the chips + return 0; + } + } + if (S64_IS_NOT_NULL($exposure->{chip_id})) { + if (($exposure->{chip_state} eq 'cleaned')|| + ($exposure->{chip_state} eq 'update')|| + ($exposure->{chip_state} eq 'goto_cleaned')|| + ($exposure->{chip_state} eq 'error_cleaned')) { + return(1); + } + } + + return(0); +} + + +# This is the "user level" subroutine. +sub queue_chips { + my $lap_id = shift; + + my $command = "$laptool -pendingexp -lap_id $lap_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -pendingexp: $error_code", $lap_id); + } + + if (@$stdout_buf == 0) { + # Nothing to do. + return(0); + } + + my $exposures = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -pendingexp", $lap_id); + + my $counter = 0; + my %matching = (); + my %indexing = (); + # Determine which exposures need a chipRun queued. + foreach my $exposure (@$exposures) { + # $lap_id = $exposure->{lap_id}; # This should be already known. + my $tess_id = $exposure->{tess_id}; + my $exp_id = $exposure->{exp_id}; + my $chip_id = $exposure->{chip_id}; + my $pair_id = $exposure->{pair_id}; + my $private = $exposure->{private}; + my $pairwise = $exposure->{pairwise}; + my $active = $exposure->{active}; + my $data_state = $exposure->{data_state}; + my $dateobs = $exposure->{dateobs}; + my $object = $exposure->{object}; + my $comment = $exposure->{comment}; + + my $updateable = determine_if_can_update($exposure); + + # This is a hack to fix old exposures that have no usable object/comment data. + unless(defined($comment)) { + $comment = ''; + } + if ((!defined($object))||($object eq 'NULL')||($object eq '')) { + if ($comment =~ /3pi_/) { + $object = $comment; + $object =~ s/^.*?(3pi_\d\d_\d\d\d\d).*?$/F1 $1/; + } + elsif ($comment =~ / ps1_/) { + $object = $comment; + $object =~ s/^.*?(ps1_\d\d_\d\d\d\d).*$/F2 $1/; + } + elsif ($comment =~ /ThreePi.*3pi_/) { + $object = $comment; + $object =~ s/^ThreePi . (\S+? 3pi_\d\d_\d\d\d\d) .*$/F3 $1/; + } + elsif ($comment =~ /ThreePi.*ps1_/) { + $object = $comment; + $object =~ s/^ThreePi . (\S+? ps1_\d\d_\d\d\d\d) .*$/F4 $1/; + } + elsif ($comment =~ /ThreePi /) { + $object = $comment; + $object =~ s/^ThreePi . (\S+? \d\d\d\d) .*$/F5 $1/; + } + elsif (($comment =~ /focus/i)|| + ($comment =~ /test/i)|| + ($comment =~ /hyster/i)|| + ($comment =~ /dither/i)|| + ($comment =~ /camera/i) + ){ + # This is junk that shouldn't exist. + $object = 'DROP'; + $exposure->{data_state} = 'drop'; + $exposure->{pairwise} = 0; + $exposure->{pair_id} = 9223372036854775807; + $exposure->{active} = 0; + &update_this_exposure($exposure); + $counter++; # To ensure everyone else is consistent + next; + } + } + + # Determine the current state of chipRuns for these exposures, and update/remake as needed. + if (S64_IS_NOT_NULL($chip_id)) { # We already have a defined chip_id + if (($pairwise) && !($pair_id)) { + # This is an error. + &my_die("Exposure $exp_id for $lap_id is declared pairwise without a defined pair", $lap_id); + } + $exposure->{data_state} = 'exists'; + if ($updateable) { # We know about this run, but the data needs to be regenerated. + $exposure->{data_state} = 'update'; + $exposure = remake_this_exposure_by_update($exposure); + } + &update_this_exposure($exposure); + $matching{$object}{$comment} = $exp_id; + $indexing{$exp_id} = $counter; + $counter++; + } + else { # We do not already have a chip_id. + # Make a chipRun, and update the exposure. + $exposure->{data_state} = 'run'; + $exposure = remake_this_exposure($exposure); + # Save our information for diff pairing. + &update_this_exposure($exposure); + $matching{$object}{$comment} = $exp_id; + $indexing{$exp_id} = $counter; + $counter++; + } + + if ($verbose) { + print "ZZ: $exp_id $object $comment $matching{$object}{$comment}\n"; + } + } + + # Determine which exposures have a pair for diffing. + foreach my $object (keys %matching) { + my @exp_ids_to_diff = (); + foreach my $comment (keys %{ $matching{$object} }) { + push @exp_ids_to_diff, $matching{$object}{$comment}; + print "$object $comment $matching{$object}{$comment} $indexing{$matching{$object}{$comment}} $exp_ids_to_diff[-1]\n"; + } + @exp_ids_to_diff = sort { $indexing{$a} <=> $indexing{$b} } @exp_ids_to_diff; # This is effectively a sort by dateobs. + + if (( $#exp_ids_to_diff + 1) % 2 != 0) { # We have an odd number of exposures, even after comment filtering + pop(@exp_ids_to_diff); # dump the last entry. + } + + while ($#exp_ids_to_diff > -1) { # Save the pair information to the opposite exposure. + my $exp_id_A = shift(@exp_ids_to_diff); + my $exp_id_B = shift(@exp_ids_to_diff); + + my $exp_A = ${ $exposures }[$indexing{$exp_id_A}]; + my $exp_B = ${ $exposures }[$indexing{$exp_id_B}]; + print "$exp_A $exp_B $exp_id_A $exp_id_B $indexing{$exp_id_A} $indexing{$exp_id_B}\n"; + if ($exp_A->{diff_id} == $exp_B->{diff_id}) { + $exp_A->{pairwise} = 1; + $exp_A->{pair_id} = $exp_B->{chip_id}; + + $exp_B->{pairwise} = 1; + $exp_B->{pair_id} = $exp_A->{chip_id}; + if ($verbose) { + print "LAP_DIFFS: $object: $exp_A->{exp_id} and $exp_B->{exp_id} are a pair\n"; + } + } + else { + $exp_A->{pairwise} = 0; + $exp_B->{pairwise} = 0; + } + } + } + + # Scan all exposures, and ensure that pairwise and private are set correctly + foreach my $exposure (@$exposures) { + if ($verbose) { + print "YY: $exposure\n"; + } + if ($exposure->{pairwise} && !($exposure->{pair_id})) { + $exposure->{pairwise} = 0; # We marked it for pairwise diffs, but didn't match it. Probably an error. + } + + update_this_exposure($exposure); + } + return(0); +} + + +# +# Decide Things +################################################################################ +sub monitor_mode { + my $lap_id = shift; + return(check_status($lap_id)); +} + + +sub check_stack_status { # look at lapRun associated stacks, and confirm their states. + my $lap_id = shift; + + my ($defined_qstack,$have_qstack,$defined_fstack,$have_fstack); + + my $command = "$laptool -stacks -lap_id $lap_id"; + $command .= " -dbname $dbname" if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -stacks: $error_code", $lap_id, ""); + } + + ($defined_qstack,$have_qstack,$defined_fstack,$have_fstack) = (0,0,0,0); + if (@$stdout_buf == 0) { + # Nothing to do. Possibly an error, but for now, just accept it + return($defined_qstack,$have_qstack,$defined_fstack,$have_fstack); + } + + my $stacks = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -stacks", $lap_id, ""); + + my $total_qstacks = 0; + my $complete_qstacks = 0; + my $total_fstacks = 0; + my $complete_fstacks = 0; + foreach my $stack (@$stacks) { + if (($stack->{quick_stack_id})&& + (S64_IS_NOT_NULL($stack->{quick_stack_id}))) { + $defined_qstack = 1; + $total_qstacks++; + } + if (($stack->{final_stack_id})&& + (S64_IS_NOT_NULL($stack->{final_stack_id}))) { + $defined_fstack = 1; + $total_fstacks++; + } + + if (($stack->{quick_state})&& + ($stack->{quick_state} eq 'full')) { + $complete_qstacks++; + } + elsif (($stack->{quick_state})&&($stack->{quick_state} eq 'new')&& + ($stack->{quick_fault} >= 4)&&($stack->{quick_fault} != 32767)) { + printf STDERR "Faulted quick stack: $stack->{quick_stack_id} $stack->{quick_fault}\n"; + $complete_qstacks++;# This is not the best solution, but if they continually fail, there's not much we can do. + } + if (($stack->{final_state})&& + ($stack->{final_state} eq 'full')) { + $complete_fstacks++; + } + elsif (($stack->{final_state})&& + ($stack->{final_state} eq 'drop')) { + $complete_fstacks++; + } + elsif (($stack->{final_state})&& + ($stack->{final_state} eq 'wait')) { + $complete_fstacks++; # Not the best either, but we've noted an issue, and tried to move on. LAP should respect this. + } + elsif (($stack->{final_state})&&($stack->{final_state} eq 'new')&& + ($stack->{final_fault} >= 4)&&($stack->{final_fault} != 32767)) { + printf STDERR "Faulted final stack: $stack->{final_stack_id} $stack->{final_fault}\n"; + $complete_fstacks++; # This is not the best solution, but if they continually fail, there's not much we can do. + } + + } + if (($complete_qstacks > 0)&& + ($complete_qstacks == $total_qstacks)) { + $have_qstack = 1; + } + if (($complete_fstacks > 0)&& + ($complete_fstacks == $total_fstacks)) { + $have_fstack = 1; + } + + + return($defined_qstack,$have_qstack,$defined_fstack,$have_fstack); +} +sub check_status { + my $lap_id = shift; + + my ($defined_qstack,$have_qstack,$defined_fstack,$have_fstack) = check_stack_status($lap_id); + + my $command = "$laptool -exposures -lap_id $lap_id"; + $command .= " -dbname $dbname" if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -exposures: $error_code", $lap_id); + } + + if (@$stdout_buf == 0) { + # Nothing to do. However, this is likely an error. + return(0); + } + + my $exposures = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -exposures", $lap_id); + + # Need to prescan to see who matches whom. + my %match_hash = (); + my $index = 0; + foreach my $exposure (@$exposures) { + if ($exposure->{pair_id}) { + $match_hash{$exposure->{pair_id}} = $index; # Tell the companion who we are, so they can find us next time. + } + $index++; + } + + # Things I want to know before I'm through +# my $needs_qstack = 0; + my $needs_something_remade = 0; # I never need something remade, because we're committed to one-exp=one-chip + my $needs_something_private = 0; # I never need something private, as that is calculated by the difference engine. +# my $can_qstack = 0; + my $have_diff = 0; + my $can_diff = 0; +# my $can_fstack = 0; + my $total_exposures = 0; + my @lonely_exposures = (); + + my $are_warped = 0; + my $are_magicked = 0; + foreach my $exposure (@$exposures) { + $total_exposures++; + my $companion; + + if ($exposure->{pairwise}) { + # Load companion exposure information + if (($exposure->{pair_id})&&(exists($match_hash{$exposure->{chip_id}}))) { + $companion = ${ $exposures }[$match_hash{$exposure->{chip_id}}]; # Match! + } + else { # We claimed to be pairwise, but do not have a valid pair_id. + $exposure->{pairwise} = 0; + &update_this_exposure($exposure); + } + } + + if ($exposure->{data_state} eq 'drop') { # This exposure is impossible, so fudge the counts so we get through. + $are_warped++; + $can_diff ++; + $have_diff ++; + $are_magicked ++; + next; + } + + if ($exposure->{data_state} eq 'pending_update') { + $exposure->{data_state} = 'update'; + $exposure = &remake_this_exposure_by_update($exposure); + &update_this_exposure($exposure); + next; + } + + if ($exposure->{private}) { # I've declared this exposure private to this lapRun. + push @lonely_exposures, $exposure; + } + +# if ($exposure->{needs_remade}) { # This does the check that private = false for other lapRun +# $needs_something_remade = 1; +# $exposure = remake_this_exposure($exposure); +# } + # Do quality checks here + if ($verbose) { + printf("TEST: %d %d %d\n",$exposure->{exp_id},$exposure->{chip_id},$exposure->{chip_component_count}); + } + # Checks to ensure we do not divide by zero. Mostly happens with old diffs, it seems. + if ($exposure->{chip_component_count} == 0) { + $exposure->{chip_component_count} = 1; + } + if ($exposure->{cam_component_count} == 0) { + $exposure->{cam_component_count} = 1; + } + if ($exposure->{warp_component_count} == 0) { + $exposure->{warp_component_count} = 1; + } + if ($exposure->{diff_component_count} == 0) { + $exposure->{diff_component_count} = 1; + } + + my $is_bad_quality = 0; + if ((defined($exposure->{chipRun_state}))&&($exposure->{chipRun_state} eq 'full')&& + ($exposure->{chip_component_count} > 0)&&($exposure->{chip_bad_quality} / $exposure->{chip_component_count} > 0.05)) { + printf("QUALITY: $exposure->{exp_id} has bad chip quality: %d / %d\n", + $exposure->{chip_bad_quality} , $exposure->{chip_component_count}); + $is_bad_quality = 1; + } + elsif ((defined($exposure->{camRun_state}))&&($exposure->{camRun_state} eq 'full')&& + ($exposure->{cam_bad_quality} / $exposure->{cam_component_count} > 0)) { + printf("QUALITY: $exposure->{exp_id} has bad cam quality: %d / %d\n", + $exposure->{cam_bad_quality} , $exposure->{cam_component_count}); + $is_bad_quality = 1; + } + elsif ((defined($exposure->{warpRun_state}))&&($exposure->{warpRun_state} eq 'full')&& + ($exposure->{warp_bad_quality} / $exposure->{warp_component_count} > 0.3)) { + printf("QUALITY: $exposure->{exp_id} has bad warp quality: %d / %d\n", + $exposure->{warp_bad_quality} , $exposure->{warp_component_count}); + $is_bad_quality = 1; + } + elsif ((defined($exposure->{diffRun_state}))&&($exposure->{diffRun_state} eq 'full')&& + ($exposure->{diff_bad_quality} / $exposure->{diff_component_count} > 0.5)) { + printf("QUALITY: $exposure->{exp_id} has bad diff quality: %d / %d\n", + $exposure->{diff_bad_quality} , $exposure->{diff_component_count}); + $is_bad_quality = 1; + } + # If we've detected a bad quality exposure, drop it, and tell the companion. + if ($is_bad_quality) { + unless ((defined($exposure->{diffRun_state}))&& + ($exposure->{diffRun_state} eq 'full')) { + $are_warped++; + if ($companion) { + $companion->{pairwise} = 0; + &update_this_exposure($companion); +# push @lonely_exposures, $companion; + } + $exposure->{pairwise} = 0; + } + $exposure->{data_state} = 'drop'; + &update_this_exposure($exposure); + next; + } + + + if (($exposure->{warpRun_state})&& # This exposure has a warp + ($exposure->{warpRun_state} eq 'full')) { # This exposure's warp is done. + $are_warped++; +# $can_qstack ++; + $can_diff ++; + ## BEGIN These two disable LAP stacks + $are_magicked = $total_exposures; + $have_diff ++; + ## END +# $exposure->{data_state} = 'to_diff'; + $exposure->{data_state} = 'full'; + } + if (($exposure->{diff_id})&& + (&S64_IS_NOT_NULL($exposure->{diff_id}))&& + (($exposure->{diffRun_state} eq 'full')|| + ($exposure->{diffRun_state} eq 'error_cleaned')|| + ($exposure->{diffRun_state} eq 'cleaned')) + ) { + $are_magicked++; + $have_diff ++; +# $exposure->{data_state} = 'to_magic'; + $exposure->{data_state} = 'full'; + } + # We no longer need to care about magic +# if (($exposure->{magicked})&& +# ($exposure->{warpRun_state})&& +# ($exposure->{warpRun_state} eq 'full')&& +# (&S64_IS_NOT_NULL($exposure->{magicked}))) { # This exposure has been magicked, so it is through with diff. +# $are_magicked++; +# $exposure->{data_state} = 'full'; +# # $can_fstack ++; +# } + unless ($debug) { + &update_this_exposure($exposure); + } + } + + print "STATUS: LAP_ID $lap_id\n"; + print "STATUS: DEFINED_QSTACK: $defined_qstack\n"; + print "STATUS: HAVE_QSTACK: $have_qstack\n"; + print "STATUS: DEFINED_FSTACK: $defined_fstack\n"; + print "STATUS: HAVE_FSTACK: $have_fstack\n"; + + print "STATUS: NEEDS_REMADE: $needs_something_remade\n"; + print "STATUS: NEEDS PRIVATIZE: $needs_something_private\n"; + print "STATUS: ARE WARPED: $are_warped\n"; + print "STATUS: ARE MAGICKED: $are_magicked\n"; + print "STATUS: CAN_DIFF: $can_diff\n"; + print "STATUS: HAVE_DIFF: $have_diff\n"; + + print "STATUS: TOTAL_EXPOSURES: $total_exposures\n"; + print "\n"; + if ($do_nothing) { + exit(0); + } + + # Do the decision making based on what we've learned + if ($are_warped == $total_exposures) { # Are all the warps done? + if ($defined_fstack == 0) { # We have not yet made any stacks. + print "STATUS: We can attempt to queue deep final stacks.\n"; + my $Nstacks_made; + unless ($debug) { + $Nstacks_made = &queue_muggle_finalstack($exposures); + } + print "STATUS: Made $Nstacks_made final stacks.\n"; + exit(0); + # If this doesn't do anything, we may end up stuck here. Therefore, we need a more robust test. + } + else { # We have made a stack before for this lapRun. + if ($have_fstack == $defined_fstack) { # We have made all the stacks we have asked for (so far) + if ($are_magicked < $total_exposures) { # But we have not yet made diffs +# if ($have_diff < $total_exposures) { # We have not yet made diffs + if (($can_diff == $total_exposures)&& # And we have exposures that should be diffed. + ($have_diff < $can_diff)) { # and we haven't made them all yet, either. + print "STATUS: Dropping unpaired exposures and making pairwise diffs.\n"; +# foreach my $exposure (@lonely_exposures) { +# $exposure->{data_state} = 'drop'; +# &update_this_exposure($exposure); +# } + unless ($debug) { + &queue_diffs($exposures); + } + exit(0); + } + else { + # This is apparently the case where we've queued diffs to run, but they have not yet + # completed though the destreak phase. + print "STATUS: Waiting for diffs/magic/destreak to complete.\n"; + exit(0); + } + } + elsif ($are_magicked >= $total_exposures) { # We have made all of the diffs, and propagated through magic + print "STATUS: We would create all remaining stacks possible, but no longer require magic.\n"; +# my $Nstacks_made = -1; +# unless ($debug) { +# $Nstacks_made = &queue_muggle_finalstack($exposures); +# } +# if ($Nstacks_made == 0) { # We have made all the stacks that we will ever make. + print "STATUS: No more stacks generated. Deactivating exposures for this complete lapRun.\n"; + unless ($debug) { + &deactivate_exposures($exposures); + + $command = "$laptool -updaterun -lap_id $lap_id"; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -set_state full "; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updaterun: $error_code", $lap_id); + } +# } + exit(0); + } +# else { +# print "STATUS: $Nstacks_made stacks made.\n"; +# exit(0); +# } + } + else { # What? + print "STATUS: More exposures magicked than exist. This is a mistake.\n"; + exit(0); + } + } + else { # We have not yet made all the stacks we've asked for. + print "STATUS: Defined $defined_fstack, completed $have_fstack. Waiting for stacking to finish.\n"; + exit(0); + } + } + } + else { # Not all warps finished. + # do nothing + print "STATUS: Not all warps are finished, waiting for that to finish.\n"; + exit(0); + } + + print "\n"; + return(0); +} + +sub queue_quickstack { + my $exposures = shift; # reference to exposure array; + my $exposure = ${ $exposures }[0]; # reference to the first exposure to get run level information + + my $lap_id = $exposure->{lap_id}; + my $label = $exposure->{label}; + my $filter = $exposure->{filter}; + my $proj_cell = $exposure->{projection_cell}; + + unless (defined($label) && defined($filter) && defined($proj_cell)) { + &my_die("Unable to perform stacktool. Insufficient information.", $lap_id); + } + + my $warps = ''; + foreach $exposure (@$exposures) { + if (($exposure->{data_state} ne 'drop')&& + (S64_IS_NOT_NULL($exposure->{warp_id}))) { + $warps .= " -warp_id $exposure->{warp_id} "; + } + } + + my @utctime = gmtime(); + $utctime[5] += 1900; + $utctime[4] += 1; + my $date = sprintf("%4d%02d%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir_date = sprintf("%4d/%02d/%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir = "neb://\@HOST\@.0/${dbname}/${label}/${workdir_date}"; + my $data_group = "${label}.${proj_cell}.quick.${lap_id}"; + + my $command = "$stacktool "; + $command .= " -pretend " if defined $debug; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -definebyquery -select_skycell_id ${proj_cell}.% -select_filter $filter "; +# $command .= " -select_label $label "; # Removed to allow exposure sharing to work + $command .= " -set_label ${label} -set_data_group $data_group "; + $command .= " -set_workdir $workdir -set_dist_group NODIST "; + $command .= " -min_num 2 -set_reduction QUICKSTACK "; + $command .= " $warps "; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -definebyquery: $error_code", $lap_id); + } + my $stacks_made = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("unable to parse metadata from stacktool -definebyquery", $lap_id, ""); + + $command = "$stacktool "; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -sassskyfile -data_group $data_group "; + $command .= " -filter $filter -projection_cell ${proj_cell} "; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -sassskyfile: $error_code", $lap_id); + } + + my $stacks = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stacktool -sassskyfile", $lap_id, ""); + + my $stack = ${ $stacks }[0]; + my $sass_id = $stack->{sass_id}; + unless (defined($sass_id)) { + &my_die("Unable to parse metadata from stacktool for sass_id", $lap_id, ""); + } + + print "QUICK_SASS_ID: $sass_id\n"; + $command = "$laptool -updaterun -lap_id $lap_id -set_quick_sass_id $sass_id"; + $command .= " -dbname $dbname " if defined $dbname; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updaterun: $error_code", $lap_id); + } + + return($#{ $stacks_made } + 1); +} +sub queue_muggle_finalstack { + my $exposures = shift; # reference to exposure array; + my $exposure = ${ $exposures }[0]; # reference to the first exposure to get run level information + + my $lap_id = $exposure->{lap_id}; + my $label = $exposure->{label}; + my $filter = $exposure->{filter}; + my $proj_cell = $exposure->{projection_cell}; + + unless (defined($label) && defined($filter) && defined($proj_cell)) { + &my_die("Unable to perform stacktool. Insufficient information.", $lap_id); + } + + my $warps = ''; + foreach $exposure (@$exposures) { + if (($exposure->{data_state} ne 'drop')&& +# (S64_IS_NOT_NULL($exposure->{magicked}))&& + (S64_IS_NOT_NULL($exposure->{warp_id}))) { + $warps .= " -warp_id $exposure->{warp_id} "; + } + } + + my @utctime = gmtime(); + $utctime[5] += 1900; + $utctime[4] += 1; + my $date = sprintf("%4d%02d%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir_date = sprintf("%4d/%02d/%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir = "neb://\@HOST\@.0/${dbname}/${label}/${workdir_date}"; + my $data_group = "${label}.${proj_cell}.final.${lap_id}"; + + + ## + ## Queue the "shallow" stacks that will run at los alamos. + my $command = "$stacktool "; + $command .= " -pretend " if defined $debug; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -definebyquery -select_skycell_id ${proj_cell}.% -select_filter $filter "; +# $command .= " -select_label $label "; # Removed to allow exposure sharing to work + $command .= " -set_label ${label} -set_workdir $workdir -set_data_group $data_group "; + $command .= " -min_num ${minimum_stack_inputs} -max_num ${maximum_stack_inputs} -set_reduction THREEPI_STACK_1DG -set_dist_group $exposure->{dist_group} "; + $command .= " $warps "; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -definebyquery: $error_code :: $command", $lap_id); + } + my $stacks_made = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("unable to parse metadata from stacktool -definebyquery", $lap_id, ""); + + ## + ## Queue the "deep" stacks that will run locally. + my $deep_minimum = $maximum_stack_inputs + 1; + if ($deep_minimum < 2) { $deep_minimum = 2; } + $command = "$stacktool "; + $command .= " -pretend " if defined $debug; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -definebyquery -select_skycell_id ${proj_cell}.% -select_filter $filter "; +# $command .= " -select_label $label "; # Removed to allow exposure sharing to work + $command .= " -set_label ${label}.local -set_workdir $workdir -set_data_group $data_group "; + $command .= " -min_num ${deep_minimum} -set_reduction THREEPI_STACK_1DG -set_dist_group $exposure->{dist_group} "; + $command .= " $warps "; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -definebyquery: $error_code :: $command", $lap_id); + } + my $stacks_made_deep = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("unable to parse metadata from stacktool -definebyquery", $lap_id, ""); + + # Append deep stacks to stacks so we can get a complete count later. + push @{ $stacks_made }, @{ $stacks_made_deep }; + + ## Determine the sass_id so we can record it in the database. + $command = "$stacktool "; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -sassskyfile -data_group $data_group "; + $command .= " -filter $filter -projection_cell ${proj_cell} "; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -sassskyfile: $error_code", $lap_id); + } + + my $stacks = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stacktool -sassskyfile", $lap_id, ""); + + my $stack = ${ $stacks }[0]; + my $sass_id = $stack->{sass_id}; + unless (defined($sass_id)) { + &my_die("Unable to parse metadata from stacktool for sass_id", $lap_id, ""); + } + print "FINAL_SASS_ID: $sass_id\n"; + $command = "$laptool -updaterun -lap_id $lap_id -set_final_sass_id $sass_id"; + $command .= " -dbname $dbname " if defined $dbname; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updaterun: $error_code", $lap_id); + } + + return($#{ $stacks_made } + 1); +} +sub queue_magic_finalstack { + my $exposures = shift; # reference to exposure array; + my $exposure = ${ $exposures }[0]; # reference to the first exposure to get run level information + + my $lap_id = $exposure->{lap_id}; + my $label = $exposure->{label}; + my $filter = $exposure->{filter}; + my $proj_cell = $exposure->{projection_cell}; + + unless (defined($label) && defined($filter) && defined($proj_cell)) { + &my_die("Unable to perform stacktool. Insufficient information.", $lap_id); + } + + my $warps = ''; + foreach $exposure (@$exposures) { + if (($exposure->{data_state} ne 'drop')&& +# (S64_IS_NOT_NULL($exposure->{magicked}))&& + (S64_IS_NOT_NULL($exposure->{warp_id}))) { + $warps .= " -warp_id $exposure->{warp_id} "; + } + } + + my @utctime = gmtime(); + $utctime[5] += 1900; + $utctime[4] += 1; + my $date = sprintf("%4d%02d%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir_date = sprintf("%4d/%02d/%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir = "neb://\@HOST\@.0/${dbname}/${label}/${workdir_date}"; + my $data_group = "${label}.${proj_cell}.final.${lap_id}"; + + my $command = "$stacktool "; + $command .= " -pretend " if defined $debug; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -definebyquery -select_skycell_id ${proj_cell}.% -select_filter $filter "; +# $command .= " -select_label $label "; # Removed to allow exposure sharing to work + $command .= " -set_label ${label} -set_workdir $workdir -set_data_group $data_group "; + $command .= " -min_num 2 -min_new 2 -set_reduction THREEPI_STACK_1DG -set_dist_group $exposure->{dist_group} "; + $command .= " $warps "; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -definebyquery: $error_code", $lap_id); + } + my $stacks_made = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("unable to parse metadata from stacktool -definebyquery", $lap_id, ""); + + $command = "$stacktool "; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -sassskyfile -data_group $data_group "; + $command .= " -filter $filter -projection_cell ${proj_cell} "; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -sassskyfile: $error_code", $lap_id); + } + + my $stacks = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stacktool -sassskyfile", $lap_id, ""); + + my $stack = ${ $stacks }[0]; + my $sass_id = $stack->{sass_id}; + unless (defined($sass_id)) { + &my_die("Unable to parse metadata from stacktool for sass_id", $lap_id, ""); + } + print "FINAL_SASS_ID: $sass_id\n"; + $command = "$laptool -updaterun -lap_id $lap_id -set_final_sass_id $sass_id"; + $command .= " -dbname $dbname " if defined $dbname; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updaterun: $error_code", $lap_id); + } + return($#{ $stacks_made } + 1); +} +sub queue_diffs { + my $exposures = shift; + + # Need to prescan to see who matches whom. + my %match_hash = (); + my $index = 0; + foreach my $exposure (@$exposures) { + if ($exposure->{pair_id}) { + $match_hash{$exposure->{pair_id}} = $index; # Tell the companion who we are, so they can find us next time. + } + $index++; + } + + my %already_queued = (); + foreach my $exposure (@$exposures) { + if ($exposure->{data_state} eq 'drop') { # Kick out unusable exposures + next; + } + if ($exposure->{diff_id}&&S64_IS_NOT_NULL($exposure->{diff_id})) { # This happens when we inherit a complete exposure. + next; + } + if ($already_queued{$exposure->{warp_id}}) { + print "STATUS: Have already queued a diff containing $exposure->{exp_id} $exposure->{chip_id} $exposure->{warp_id}\n"; + next; + } + + my @utctime = gmtime(); + $utctime[5] += 1900; + $utctime[4] += 1; + + my $label = $exposure->{label}; + my $dist_group = $exposure->{dist_group}; + my $date = sprintf("%4d%02d%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir_date = sprintf("%4d/%02d/%02d",$utctime[5],$utctime[4],$utctime[3]); + my $workdir = "neb://\@HOST\@.0/${dbname}/${label}/${workdir_date}"; + my $data_group = "${label}.${date}"; + + + my $command = "$difftool "; + $command .= " -pretend " if defined $debug; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -set_label $label -set_workdir $workdir -set_data_group $data_group "; + if ($exposure->{dist_group}) { + $command .= " -set_dist_group $exposure->{dist_group} "; + } + my $retry_command; + if (($exposure->{pairwise})&&(defined(${ $exposures }[$match_hash{$exposure->{chip_id}}]))) { # warpwarp + my $companion = ${ $exposures }[$match_hash{$exposure->{chip_id}}]; + $command .= " -definewarpwarp "; +# $command .= "-input_label $label -template_label $label "; + $command .= "-warp_id $exposure->{warp_id} -template_warp_id $companion->{warp_id} "; + $retry_command = $command; + $command .= " -backwards "; # This usually works. + $already_queued{$exposure->{warp_id}} = 1; + $already_queued{$companion->{warp_id}} = 1; + + } + else { # warp-qstack + # We need to decide if we can make a warp-stack diff: + if (&can_warp_stack_diff_be_made($exposure)) { +# next; +# $command .= '-pretend'; + $command .= " -definewarpstack -available -good_frac 0.2 "; + $command .= " -warp_id $exposure->{warp_id} -stack_label ${label} "; + $already_queued{$exposure->{warp_id}} = 1; + $exposure->{private} = 0; + &update_this_exposure($exposure); + } + else { + $exposure->{private} = 1; + $exposure->{data_state} = 'drop'; + $already_queued{$exposure->{warp_id}} = 1; + &update_this_exposure($exposure); + next; + } + } + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to perform difftool -definewarp(warp|stack): $error_code", $exposure->{lap_id}, $exposure->{proj_cell}); + } + + my $diffs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from difftool -definewarp(warp|stack)", $lap_id, ""); + + my $diff = ${ $diffs }[0]; + my $diff_id = $diff->{diff_id}; + unless (defined($diff_id)) { + if ($retry_command) { + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $retry_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to perform difftool -definewarp(warp|stack): $error_code", $exposure->{lap_id}, $exposure->{proj_cell}); + } + + $diffs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from difftool -definewarp(warp|stack)", $lap_id, ""); + + $diff = ${ $diffs }[0]; + $diff_id = $diff->{diff_id}; + } + unless (defined($diff_id)) { + $exposure->{data_state} = 'drop'; + &update_this_exposure($exposure); + } + } + } +} + +sub can_warp_stack_diff_be_made { + my $exposure = shift; + my $lap_id = $exposure->{lap_id}; + my $warp_id = $exposure->{warp_id}; + + my $command = "$laptool -diffcheck -lap_id $lap_id -warp_id $warp_id"; + $command .= " -dbname $dbname " if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -diffcheck: $error_code", $lap_id, $warp_id); + } + if (@$stdout_buf == 0) { + return(0); + } + my $skycells = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -diffcheck", $lap_id, $warp_id); + foreach my $skycell (@$skycells) { + unless (defined($skycell->{stack_state})) { + return(0); + } + if ($skycell->{stack_state} ne 'full') { + return(0); + } + if ($skycell->{warp_state} ne 'full') { + return(0); + } + unless (S64_IS_NOT_NULL($skycell->{stack_id})) { + return(0); + } + } + return(1); +} + + +# Deactivate all exposures in this run. +sub deactivate_exposures { + my $exposures = shift; + foreach my $exposure (@$exposures) { + if ($exposure->{private} == 1) { # This can probably be relaxed since we can update an undestreaked warp. + $exposure->{active} = 1; + } + else { + $exposure->{active} = 0; + } + update_this_exposure($exposure); + } +} + + +# +# Cleanup +################################################################################ + +sub cleanup_mode { + my $lap_id = shift; + + if (defined($queue_list)) { + my $successful = 1; + open(Q,$queue_list) or ($successful = 0); + if ($successful == 1) { + while() { + chomp; + my $cmd = $_; + my ($projection_cell,$seq_id,$filter,$label); + $projection_cell = $cmd; + $projection_cell =~ s/.*?-projection_cell (skycell.\w+?) .*/$1/; + $seq_id = $cmd; + $seq_id =~ s/.*-seq_id (\d+?) .*/$1/; + $filter = $cmd; + $filter =~ s/.*-filter (\w\.00000) .*/$1/; + if ($filter =~ /\s+?/) { + $filter =~ s/.*-filter (\w\.00000)$/$1/; + } + $label = $cmd; + $label =~ s/.*-label (.+?) .*/$1/; + + my $response; + chomp($response = + `laptool -dbname gpc1 -listrun -projection_cell $projection_cell -seq_id $seq_id -filter $filter -label $label -simple`); + my $state = (split /\s+/, $response)[5]; + + unless (defined($state)) { + if ($verbose) { + print "Queuing: $cmd\n"; + } + system($cmd); + + my $i = 0; + do { + sleep(5); + chomp($response = + `laptool -dbname gpc1 -listrun -projection_cell $projection_cell -seq_id $seq_id -filter $filter -label $label -simple`); + $state = (split /\s+/, $response)[5]; + $i++; + unless(defined($state)) { + $successful = 0; + } + } while (($state ne 'run')&&($i < 20)&&($successful)); + last; + } + } + close(Q); + } + } + + my $command = "$laptool -inactiveexp -lap_id $lap_id "; + $command .= " -dbname $dbname " if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -inactiveexp: $error_code", "none", "none"); + } + if (@$stdout_buf == 0) { + # Nothing to do. + $command = "$laptool -updaterun -lap_id $lap_id"; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -set_state done "; + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updaterun: $error_code", $lap_id); + } + + return(0); + } + + my $exposures = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -inactiveexp", $lap_id); + + my @clean_modes = ( + 'chiptool -dbname @DBNAME@ -updaterun -set_state goto_cleaned -set_label goto_cleaned -label @LABEL@ -chip_id @CHIP_ID@', +# 'warptool -dbname @DBNAME@ -updaterun -set_state goto_cleaned -set_label goto_cleaned -label @LABEL@ -warp_id @WARP_ID@', + 'difftool -dbname @DBNAME@ -updaterun -set_state goto_cleaned -set_label goto_cleaned -label @LABEL@ -diff_id @DIFF_ID@', + 'magictool -dbname @DBNAME@ -updaterun -set_state full -set_label @LABEL@.old -magic_id @MAGIC_ID@', + 'magicdstool -dbname @DBNAME@ -updaterun -set_state goto_cleaned -state full -set_label goto_cleaned -stage chip -stage_id @CHIP_ID@', + 'magicdstool -dbname @DBNAME@ -updaterun -set_state goto_cleaned -state full -set_label goto_cleaned -stage warp -stage_id @WARP_ID@', + 'magicdstool -dbname @DBNAME@ -updaterun -set_state goto_cleaned -state full -set_label goto_cleaned -stage diff -stage_id @DIFF_ID@'); + + foreach my $exposure (@$exposures) { + if ($exposure->{is_in_use}) { + next; + } + foreach my $clean_mode (@clean_modes) { + my $command = $clean_mode; + $command =~ s/\@DBNAME\@/$dbname/g; + if ($command =~ /\@CHIP_ID\@/) { + if (S64_IS_NOT_NULL($exposure->{chip_id})) { + $command =~ s/\@CHIP_ID\@/$exposure->{chip_id}/; + } + else { + next; + } + } + if ($command =~ /\@WARP_ID\@/) { + if (S64_IS_NOT_NULL($exposure->{warp_id})) { + $command =~ s/\@WARP_ID\@/$exposure->{warp_id}/; + } + else { + next; + } + } + if ($command =~ /\@DIFF_ID\@/) { + if (S64_IS_NOT_NULL($exposure->{diff_id})) { + $command =~ s/\@DIFF_ID\@/$exposure->{diff_id}/; + } + else { + next; + } + } + if ($command =~ /\@MAGIC_ID\@/) { + if ((S64_IS_NOT_NULL($exposure->{magicked}))&& + ($exposure->{magicked} > 0)) { + $command =~ s/\@MAGIC_ID\@/$exposure->{magicked}/; + } + else { + next; + } + } + $command =~ s/\@LABEL\@/$exposure->{label}/; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform cleantool: $command : $error_code", "none", "none"); + } + } + $exposure->{data_state} = 'cleaned'; + update_this_exposure($exposure); + } + + # Cleanup quickstacks. + $command = "$laptool -stacks -lap_id $lap_id"; + $command .= " -dbname $dbname" if defined $dbname; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -stacks: $error_code", "none", "none"); + } + if (@$stdout_buf == 0) { + # Nothing to do. + return(0); + } + + my $stacks = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from laptool -inactiveexp", $lap_id); + + + @clean_modes = ( + 'stacktool -dbname @DBNAME@ -updaterun -set_state goto_cleaned -set_label goto_cleaned -label @LABEL@ -stack_id @STACK_ID@'); + foreach my $stack (@$stacks) { + if (!S64_IS_NOT_NULL($stack->{quick_stack_id})) { + next; + } + foreach my $clean_mode (@clean_modes) { + my $command = $clean_mode; + $command =~ s/\@DBNAME\@/$dbname/g; + $command =~ s/\@LABEL\@/$stack->{label}/; + $command =~ s/\@STACK_ID\@/$stack->{quick_stack_id}/; + + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform cleantool: $command : $error_code", "none", "none"); + } + } + } + + $command = "$laptool -updaterun -lap_id $lap_id"; + $command .= " -dbname $dbname " if defined $dbname; + $command .= " -set_state done "; + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updaterun: $error_code", $lap_id); + } + return(0); +} + + + + +# +# Utilities +################################################################################ + +sub my_die { + my $msg = shift; # Warning message on die + my $lap_id = shift; # identifier + my $optional = shift; + my $exit_code = shift; + unless (defined $exit_code) { + $exit_code = $PS_EXIT_PROG_ERROR; + } + carp($msg); + exit $exit_code; +} + +# Check to see if a 64bit integer is NULL or not. This is probably fragile, but I don't know how to get a S64 NULL out. +sub S64_IS_NOT_NULL { + if ($_[0] == 9223372036854775807) { + return(0); + } + else { + return(1); + } +} + +# Take the current exposure structure, and save it to the database. +sub update_this_exposure { + my $exposure = shift; + + # These are required + my $lap_id = $exposure->{lap_id}; + my $exp_id = $exposure->{exp_id}; + + my $command = "$laptool -updateexp -lap_id $lap_id -exp_id $exp_id "; + $command .= " -dbname $dbname " if defined $dbname; + if (($exposure->{chip_id})&&(S64_IS_NOT_NULL($exposure->{chip_id}))) { + $command .= " -set_chip_id $exposure->{chip_id} "; + } + if (($exposure->{pair_id})&&(S64_IS_NOT_NULL($exposure->{pair_id}))) { + $command .= " -set_pair_id $exposure->{pair_id} "; + } + + if ($exposure->{private}) { + $command .= " -private "; + } + else { + $command .= " -public "; + } + if ($exposure->{pairwise}) { + $command .= " -pairwise "; + } + else { + $command .= " -nopairwise "; + } +# if ($exposure->{active}) { + unless ($exposure->{active} == 0) { + $command .= " -active "; + } + else { + $command .= " -inactive "; + } + if ($exposure->{data_state}) { + $command .= " -set_data_state $exposure->{data_state} "; + } + unless ($do_nothing) { + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform laptool -updateexp: $error_code", $exposure->{lap_id}, $exposure->{proj_cell}); + } + } +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/listvideocells.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/listvideocells.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/listvideocells.pl (revision 41105) @@ -0,0 +1,71 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $fhead = can_run('fhead') or (warn "Can't find fhead" and $missing_tools = 1); + +my ($uri, $verbose); + +# Parse the command-line arguments +GetOptions( + 'file=s' => \$uri, # uri to examine + 'verbose' => \$verbose, # Print stuff? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --file", + -exitval => 3) unless + defined $uri; + +my $num_ext = 0; +my $num_video_ext = 0; +for (my $i = 0; ; $i++) { + my $command = "$fhead -x $i $uri | grep EXTNAME"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + if ($error_code != 1) { + carp("Unable to perform $command: $error_code"); + exit $error_code; + } + last; + } + $num_ext++; + + my $output = join "", @$stdout_buf; + chomp $output; + last if ! $output; + + my ($exttag, undef, $extname) = split " ", $output; + + last if !$exttag; + + die ("unexpected output from fhead: $output") unless $exttag eq 'EXTNAME'; + + if ($extname =~ /video_table/) { + $num_video_ext++; + # get rid of the quotes in the ftable output + $extname =~ s/\'//g; + my (undef, undef, $cell) = split "_", $extname; + print "$cell\n"; + } +} + +die "no extensions found in $uri" unless $num_ext > 0; +print "no video extensions found in $uri" unless $num_video_ext > 0; +exit 0; Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lossy_compress_imfile.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lossy_compress_imfile.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/lossy_compress_imfile.pl (revision 41105) @@ -0,0 +1,244 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + + +use Digest::MD5::File qw( file_md5_hex ); +use File::Basename qw( basename); +use IPC::Run; +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Config 1.01 qw( :standard ); +use PS::IPP::Metadata::Config; +use File::Temp qw( tempfile ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $regtool = can_run( 'regtool' ) or (warn "Can't find regtool" and $missing_tools = 1); +my $fpack = can_run( 'fpack' ) or (warn "Can't find fpack" and $missing_tools = 1); +my $funpack = can_run( 'funpack' ) or (warn "Can't find funpack" and $missing_tools = 1); +my ($exp_id, $class_id, $exp_name, $uri, $bytes, $md5sum, $dbname, $state); +my ($verbose, $no_update, $no_op, $logfile, $save_temps); +my ($camera); +GetOptions( + 'exp_id|e=s' => \$exp_id, + 'class_id|i=s' => \$class_id, + 'exp_name|n=s' => \$exp_name, + 'camera=s' => \$camera, + 'uri|u=s' => \$uri, + 'bytes=s' => \$bytes, + 'md5sum=s' => \$md5sum, + 'dbname|d=s' => \$dbname, + 'state=s' => \$state, + 'verbose' => \$verbose, + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'logfile=s' => \$logfile, + 'save-temps' => \$save_temps, + ) or pod2usage ( 2 ); + + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --exp_id --class_id --exp_name --uri --camera --state", -exitval => 3) unless + defined $exp_id and + defined $class_id and + defined $exp_name and + defined $uri and + defined $camera and + defined $state; + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $exp_id, $exp_name, $class_id, $uri, $state, $PS_EXIT_CONFIG_ERROR ); +if (defined($logfile)) { + $ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $exp_id, $exp_name, $class_id, $uri, $state, $PS_EXIT_SYS_ERROR ); +} + +my $RECIPE = "LOSSYCOMP"; + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + + + +my $now_time = localtime(); +printf STDERR "\nstarting compression: %s\n", $now_time if $verbose; + + +# If goto_compress +# - verify disk file matches +# - create compressed version +# - update database +# + +if ($state eq 'goto_compressed') { + # Find the actual filename for this run: + &my_die("Couldn't find input file: $uri\n", $exp_id,$exp_name,$class_id,$uri,$state,$PS_EXIT_SYS_ERROR) + unless ($ipprc->file_exists($uri)); + my $uriReal = $ipprc->file_resolve( $uri ); + + # Create a compressed version: + my $compUri = $uri . ".fz"; + &my_die("Output compressed file already exists: $compUri\n", $exp_id,$exp_name,$class_id,$uri,$state,$PS_EXIT_SYS_ERROR) + if ($ipprc->file_exists($compUri)); + my $compReal= $ipprc->file_resolve( $compUri, 'create'); + # Apparently we need to funpack before fpacking. Probably should have realized that beforehand. + my $tempfile = new File::Temp ( TEMPLATE => "${exp_name}.XXXX", + DIR => '/tmp/', + UNLINK => !$save_temps, + SUFFIX => '.fits'); + my $tempReal = $tempfile->filename; + + my $uncompress_command = "$funpack -S $uriReal > $tempReal"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = + run(command => $uncompress_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to uncompress file: $uri -> $compUri: $error_code", + $exp_id,$exp_name,$class_id,$uri, $state, $PS_EXIT_SYS_ERROR); + } + my $compress_command = "$fpack -h -s 8 -S $tempReal > $compReal"; + print STDERR "$compReal $uriReal $compress_command\n"; + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = + run(command => $compress_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to compress file: $uri -> $compUri: $error_code", + $exp_id,$exp_name,$class_id,$uri, $state, $PS_EXIT_SYS_ERROR); + } + my $database_command = "$regtool -updateprocessedimfile -exp_id $exp_id -class_id $class_id -set_state compressed"; + $database_command .= " -dbname $dbname" if defined $dbname; + + &my_die("Expected output compressed file not found: $compUri\n", $exp_id,$exp_name,$class_id, $uri,$state, $PS_EXIT_SYS_ERROR) + unless ($ipprc->file_exists($compUri)); + + if ($no_update || $no_op) { + print STDERR "NOUPDATE: $database_command\n"; + } + else { + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = + run(command => $database_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to update database file: $uri -> $compUri: $error_code", + $exp_id,$exp_name,$class_id,$uri, $state, $PS_EXIT_SYS_ERROR); + } + } + exit(0); +} +# If goto_lossy +# - verify disk file matches +# - verify compressed version && create if not found +# - swap nebulous keys +# - update gpc1 database with bytes/md5sum and set state +# - remove original version + +if ($state eq 'goto_lossy') { + # Confirm we have both files + &my_die("Couldn't find original file: $uri\n", $exp_id,$exp_name,$class_id,$uri,$state,$PS_EXIT_SYS_ERROR) + unless($ipprc->file_exists($uri)); + my $uriReal = $ipprc->file_resolve( $uri ); + + my $compUri = $uri . ".fz"; + unless($ipprc->file_exists($compUri)) { + &my_die("Couldn't find compressed version of the file: $compUri\n", + $exp_id,$exp_name,$class_id,$uri,$state,$PS_EXIT_SYS_ERROR); + + # If that die is removed, this will compress things as well. + # +# &my_die("Output compressed file already exists: $compUri\n", +# $exp_id,$exp_name,$class_id,$uri,$PS_EXIT_SYS_ERROR) +# if ($ipprc->file_exists($compUri)); +# my $compReal= $ipprc->file_resolve( $compUri, 'create'); + +# my $compress_command = "$fpack -h -s 8 -S $uriReal > $compReal"; +# print STDERR "$compReal $uriReal $compress_command\n"; +# my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = +# run(command => $compress_command, verbose => $verbose); +# unless ($success) { +# $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); +# &my_die("Unable to compress file: $uri -> $compUri: $error_code", +# $exp_id,$exp_name,$class_id,$uri, $PS_EXIT_SYS_ERROR); +# } + } + + # Swap keys + my $compReal = $ipprc->file_resolve( $compUri ); + my ($new_bytes, $new_md5) = (-s $compReal,file_md5_hex($compReal)); + my $neb = $ipprc->nebulous(); + + unless ($no_op) { + $neb->replicate($compUri); + $neb->swap($uri,$compUri) or + &my_die("Nebulous swap failed between $uri and $compUri", + $exp_id,$exp_name,$class_id,$uri,$state,$PS_EXIT_SYS_ERROR); + } + # Update database + + my $database_command = "$regtool -updateprocessedimfile -exp_id $exp_id -class_id $class_id -set_state lossy "; + $database_command .= " -set_bytes $new_bytes -set_md5sum $new_md5 "; + + $database_command .= " -dbname $dbname" if defined $dbname; + + if ($no_update || $no_op) { + print STDERR "NOUPDATE: $database_command\n"; + } + else { + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = + run(command => $database_command, verbose => $verbose); + unless($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + $neb->swap($uri,$compUri) or + &my_die("DB update failed and Nebulous swap-back failed between $uri and $compUri", + $exp_id,$exp_name,$class_id,$uri,$state,$PS_EXIT_SYS_ERROR); + &my_die("Unable to update database file: $uri -> $compUri: $error_code", + $exp_id,$exp_name,$class_id,$uri, $state,$PS_EXIT_SYS_ERROR); + } + # remove original version + $neb->delete($compUri); + } + exit(0); +} + +die "lossy_compress_imfile.pl -state $state not recognized\n"; + + + +sub my_die { + my $msg = shift; # Warning message on die + my $exp_id = shift; # exp_id + my $exp_name = shift; # exp_name + my $class_id = shift; # Class identifier + my $uri = shift; # uri for the file + my $state = shift; + my $exit_code = shift; # Exit code + # outputImage and path_base are globals + my $fail_state = $state; + $fail_state =~ s/goto_/error_/; + my $error_command = "$regtool -updateprocessedimfile -exp_id $exp_id -class_id $class_id -set_state $fail_state "; + $error_command .= " -dbname $dbname" if defined $dbname; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = + run(command => $error_command, verbose => $verbose); + unless($success) { + warn("Failed at setting the error state too."); + } + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + exit $exit_code; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_cleanup.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_cleanup.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_cleanup.pl (revision 41105) @@ -0,0 +1,158 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename dirname ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); +use Nebulous::Client; +use DBI; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $magictool = can_run('magictool') or (warn "Can't find magictool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($magic_id, $exp_id, $outroot, $camera); +my ($dbname, $verbose, $no_update, $no_op, $logfile); + +GetOptions( + 'magic_id=s' => \$magic_id, # Magic run identifier + 'outroot=s' => \$outroot, # directory to clean up + 'camera=s' => \$camera, # directory to clean up + 'logfile=s' => \$logfile, + + 'exp_id=s' => \$exp_id, # exposure id # XXX: do we need this? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --magic_id --exp_id --outroot --camera", + -exitval => 3) unless + defined $magic_id and + defined $exp_id and + defined $outroot and + defined $camera; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$ipprc->outroot_prepare($outroot); +$ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $magic_id, $PS_EXIT_SYS_ERROR ) if $logfile; + +my $parentdir = dirname($outroot); +if (-e $parentdir ) { + my @extensions = ('.list', '.streakMap', '.streaks', '.clusters', '_hough.fits'); + foreach my $ext (@extensions) { + my $n = 0; + my $path = $outroot . '*' . $ext; + my @files = glob($path); + foreach my $file (@files) { + if (-e $file) { + $n++; + unless ($no_op) { + # remove this print + # print "unlinking $file\n"; + unlink $file or my_die ("unable to delete $file", $magic_id, $PS_EXIT_SYS_ERROR); + } else { + print "Skipping unlink $file\n"; + } + } + } + print "Deleted $n $ext files\n" unless $no_op; + } + # remove the verify directory + my $verify_dir = $parentdir . "/$exp_id.mgc.$magic_id.verify"; + if (-e $verify_dir ) { + my $rc = system "rm -r $verify_dir"; + my_die("failed to rm $verify_dir", $magic_id, $rc >> 8) if $rc; + print "deleted $verify_dir\n"; + } +} else { + # parent directory doesn't "exist" either, check that mountpoint exists + # if it doesn't assume nfs error and fault + # we expect at least /data/volume + my @dirs = split "/", $parentdir; + # so the following should be true + # $dirs[0] eq "" + # $dirs[1] eq 'data' + # $dirs[2] eq the volume: for example ipp053.0 + if ((scalar(@dirs) < 3) or ($dirs[0] ne "") or ($dirs[1] ne 'data')) { + my_die("unexpected parent of outroot found: '$parentdir'", $magic_id, $PS_EXIT_UNKNOWN_ERROR); + } else { + # re-form mountpoint + my $mountpoint = "/$dirs[1]/$dirs[2]"; + # check if it is readable + if (! -e $mountpoint or ! -r $mountpoint ) { + my_die("mount point for outroot not found or not readable: '$mountpoint'", $magic_id, $PS_EXIT_SYS_ERROR); + } + } + print "Workdir $outroot not found. Setting magicRun.workdir_state to cleaned.\n"; + # fall through to update workdir_state +} + +my $command = "$magictool -setworkdirstate -magic_id $magic_id -set_workdir_state cleaned"; +$command .= " -dbname $dbname" if defined $dbname; +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_id"); + } +} else { + print "Skipping command: $command\n"; +} +exit 0; + +sub my_die +{ + my $msg = shift; # Warning message on die + my $magic_id = shift; # Magic DS identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless $exit_code; + + my $command = "$magictool -setworkdirstate -set_workdir_state error_cleaned"; + $command .= " -magic_id $magic_id"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_id"); + } + } else { + print "Skipping command: $command\n"; + } + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak.pl (revision 41105) @@ -0,0 +1,697 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile tempdir ); +use File::Basename qw( basename dirname ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); +use Nebulous::Client; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +my $streaksremove = can_run('streaksremove') or (warn "Can't find streaksremove" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $censorObjects = can_run('censorObjects') or (warn "Can't find censorObjects" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $dvoImageOverlaps = can_run('dvoImageOverlaps') or (warn "Can't find dvoImageOverlaps" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($magic_ds_id, $camera, $streaks, $inv_streaks, $exp_id, $stage, $stage_id, $component, $uri, $path_base, $cam_path_base, $cam_reduction); +my ($streaks_path_base, $inv_streaks_path_base, $run_state); +my ($outroot, $recoveryroot, $magicked); +my ($replace, $release); +my ($diff_tess_id, $mismatched_tess); +my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile); + +GetOptions( + 'magic_ds_id=s' => \$magic_ds_id,# Magic destreak run identifier + 'camera=s' => \$camera, # camera for evaluating file rules + 'run-state=s' => \$run_state, # state of run (new or update) + 'streaks_path_base=s' => \$streaks_path_base, # path_base for streaks data + 'inv_streaks_path_base=s' => \$inv_streaks_path_base, #path_base for streaks from inverse diff + 'inv_streaks=s' => \$inv_streaks,# file containing the list of streaks from the inverse diff + 'streaks=s' => \$streaks, # file containing the list of streaks + 'inv_streaks=s' => \$inv_streaks,# file containing the list of streaks from the inverse diff + 'exp_id=s' => \$exp_id, # exp_id, chip_id, warp_id, or diff_id + 'stage=s' => \$stage, # raw, chip, warp, or diff + 'stage_id=s' => \$stage_id, # exp_id, chip_id, warp_id, or diff_id + 'component=s' => \$component, # the class_id or skycell_id + 'mismatched_tess'=> \$mismatched_tess, # true if tess_id of input does not match tess_id of the diff used for magic + 'diff_tess_id=s' => \$diff_tess_id, # tess_id of diffRun used to compute the streaks + 'uri=s' => \$uri, # uri of the input image + 'path_base=s' => \$path_base, # path_base of the input + 'cam_path_base=s'=> \$cam_path_base, # path_base from camera stage (for chip and raw) + 'cam_reduction=s'=> \$cam_reduction, # reduction class from camera stage (for chip and raw) + 'outroot=s' => \$outroot, # "directory" for temporary images (may be nebulous) + 'recoveryroot=s' => \$recoveryroot,# "prefix" for saving the images of excised pixels + 'replace=s' => \$replace, # replace the input images with the results. + 'magicked=s' => \$magicked, # magicked state of the run + 'release' => \$release, # NAN masked pixels for release + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --magic_ds_id --camera --run_state --streaks --stage --stage_id --component --uri --path_base --outroot --magicked", + -exitval => 3) unless + defined $magic_ds_id and + defined $camera and + defined $run_state and + defined $streaks and + defined $streaks_path_base and + defined $stage and + defined $stage_id and + defined $exp_id and + defined $component and + defined $uri and + defined $path_base and + defined $outroot and + defined $magicked; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +if ($logfile) { + $ipprc->redirect_to_logfile($logfile) or my_die( "Unable to redirect output", $magic_ds_id, $component, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Continuing script $0 on $host at $date\n\n"; +} + +$cam_reduction = 'DEFAULT' if !$cam_reduction or ($cam_reduction eq 'NULL'); + +my $recipe_psastro = $ipprc->reduction($cam_reduction, 'PSASTRO'); # Recipe to use +&my_die("Unrecognised PSASTRO recipe", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) unless defined $recipe_psastro; + +my ($skycell_args, $class_id, $skycell_id); + +if (($stage eq "raw") or ($stage eq "chip") or $stage eq "chip_bg") { + $class_id = $component; + $skycell_args = " -class_id"; +} elsif ($stage eq "warp" or $stage eq "warp_bg") { + $skycell_id = $component; + $skycell_args = " -skycell_id"; +} elsif ($stage eq "diff") { + $skycell_id = $component; +} elsif ($stage ne "camera") { + &my_die("Invalid value for stage: $stage", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); +} + +&my_die("Invalid value for run-state: $run_state", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) + unless ($run_state eq 'new') or ($run_state eq 'update'); + +$inv_streaks_path_base = undef if defined($inv_streaks_path_base) and ($inv_streaks_path_base eq "NULL"); +$inv_streaks = undef if defined($inv_streaks) and ($inv_streaks eq "NULL"); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my $dirname = dirname($path_base); +my $basename = basename($path_base); +my $nebulousInput = inNebulous($dirname); +my $nebulousOutput = inNebulous($outroot); + +# parse replace arguments check for errors and set up +# the appropriate paths +my $nebulous; +if (defined($replace) and ($replace eq "T")) { + # for camera stage we need a handle to the nebulous server + if ($stage eq 'camera') { + my $nebulousServer = metadataLookupStr( $ipprc->{_siteConfig}, 'NEB_SERVER' ); + &my_die("cannot find NEB_SERVER in site configuration", + $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) + if !$ nebulousServer; + + $nebulous = eval { Nebulous::Client->new( proxy => $nebulousServer ); }; + if ($@ or not defined $nebulous) { + &my_die ("Unable to create a Nebulous::Client object with proxy $nebulousServer", + $magic_ds_id, $component , $PS_EXIT_UNKNOWN_ERROR); + } + } + $replace = 1; +} else { + $replace = 0; +} + + +# We don't use recoveryroot for camera stage +if ($stage eq 'camera') { + $recoveryroot = undef; +} + +# default value is "NULL" do not use +if (defined($recoveryroot) and ($recoveryroot eq "NULL")) { + $recoveryroot = undef; +} + +if (($stage eq "raw") and $replace and ! $recoveryroot) { + &my_die("Can not replace raw files without defining recoveryroot.", + $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); +} + +# create the output directories if it is not a nebulous path and it doesn't exist +if (! $nebulousOutput) { + if (! -e $outroot ) { + my $code = system "mkdir -p $outroot"; + &my_die("cannot create output directory $outroot", $magic_ds_id, $component, + $code >> 8) if $code; + } +} + +# XXX: create a DESTREAK file rule. For now just steal one that will work +my $error; +my $statsFile = $ipprc->prepare_output("PSASTRO.STATS", "$outroot/$exp_id.mds.$magic_ds_id.$stage_id.$component", undef, 1, \$error) or &my_die("failed to prepare output for stats", $magic_ds_id, $component, $error); + +my $backup_path_base; +my $tmproot; +if ($replace) { + # in replace mode, we place the output files in the same "directory" as the inputs + # Nebulous requires this for the two inputs to nebSwap which we use + # We prepend the path with SR_ This causes the filenames for instances of the swapped files to + # have SR in them. + $tmproot = $dirname . "/SR_"; + $backup_path_base = $tmproot . "$basename"; +} else { + # note: trailing / is necessary + $tmproot = "$outroot/"; + $backup_path_base = $tmproot . $basename; +} + +my $recovery_path_base; +if ($recoveryroot) { + # recoveryroot is a path to prepend to the basenames of the input files + if (inNebulous($recoveryroot)) { + # if recoveryroot is a nebulous path we ignore the actual path and put the files in the + # the same "directory" as the input files + $recoveryroot = "$dirname/REC_"; + $recovery_path_base = $recoveryroot . $basename; + } else { + # otherwise we put the files in recoveryroot. + # Regardless, we prefix the basename with 'REC_' + $ipprc->outroot_prepare($recoveryroot); + $recovery_path_base = "$recoveryroot/REC_$basename"; + } +} + +my $temp_dir; + +if ($stage ne "camera") { + # get skycell list if needed + my ($sfh, $skycell_list); + if ($skycell_args) { + my $command = "$magicdstool -magic_ds_id $magic_ds_id -getskycells"; + $command .= " $skycell_args"; + $command .= " -dbname $dbname" if $dbname; + my @diff_components; + if ($mismatched_tess) { + # tessellation for this skycell does not match the tessellation used for the magic analysis + # used to calculate the streaks file + @diff_components = get_overlaps($path_base, $component, $diff_tess_id); + } else { + @diff_components = ($component); + } + + # hash of uris by skycell. + my %diff_skycells; + foreach my $component (@diff_components) { + my $this_command = "$command $component"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $this_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magicdstool -diffskyfile $skycell_args: $error_code", $magic_ds_id, $component, $error_code); + } + + my $getskycells_output = join "", @$stdout_buf; + if ($getskycells_output) { + my $metadata = $mdcParser->parse($getskycells_output) or + &my_die("Unable to parse metadata config doc", $magic_ds_id, $component, $PS_EXIT_PROG_ERROR); + + my $skycells = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $magic_ds_id, $component, $PS_EXIT_PROG_ERROR); + + foreach my $skycell (@$skycells) { + my $skycell_uri; + $skycell->{quality} = undef; + # XXXXXXXX remake all skycells to avoid dead instances (ipp064) + if (0 and $skycell->{data_state} eq "full" and $skycell->{quality} == 0) { + $skycell_uri = $ipprc->filename("PPSUB.OUTPUT", $skycell->{path_base}); + my $skycell_id = $skycell->{skycell_id}; + $diff_skycells{$skycell_id} = $skycell_uri; + } else { + # diff run must have been cleaned up, need to create this skycell file on the fly + if (!defined $temp_dir ) { + $temp_dir = tempdir( CLEANUP => !$save_temps); + } + my $skycell_id = $skycell->{skycell_id}; + if (!$diff_skycells{$skycell_id}) { + $skycell_uri = "$temp_dir/$skycell_id"; + $ipprc->skycell_file($skycell->{tess_id}, $skycell_id, $skycell_uri, $verbose) or + &my_die("failed to create skycell file for $skycell_id", $magic_ds_id, $component, $PS_EXIT_PROG_ERROR); + } + $diff_skycells{$skycell_id} = $skycell_uri; + } + } + } + } + # write the skycell list file + ($sfh, $skycell_list) = tempfile( "/tmp/skycell_list.XXXX", UNLINK => !$save_temps); + foreach my $skycell_id (keys %diff_skycells) { + print $sfh $diff_skycells{$skycell_id} . "\n"; + } + close $sfh + } + + my ($image, $mask, $ch_mask, $weight, $astrom, $sources); + + # if we're destreaking a bothways diff need to combine the + # two streaks files + my ($allstreaks_fh, $allstreaks_name); + + # Set name of streaks files from their path_base. Note. ne 'NULL' test is for backward compatability + # with runs that don't have path_base set yet + if ($streaks_path_base ne 'NULL') { + $streaks = "$streaks_path_base.streaks"; + } + if ($inv_streaks_path_base and ($inv_streaks_path_base ne 'NULL')) { + $inv_streaks = "$inv_streaks_path_base.streaks"; + } + + my $streaks_resolved = $ipprc->file_resolve($streaks) or &my_die("failed to resolve streaks file $streaks", $magic_ds_id, $component, $PS_EXIT_SYS_ERROR); + my $inv_streaks_resolved; + if ($inv_streaks) { + $inv_streaks_resolved = $ipprc->file_resolve($inv_streaks) or &my_die("failed to resolve inverse streaks file $inv_streaks", $magic_ds_id, $component, $PS_EXIT_SYS_ERROR); + } + + + if ($stage eq "raw") { + $image = $uri; + $astrom = $ipprc->filename("PSASTRO.OUTPUT", $cam_path_base); + $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $cam_path_base, $class_id) if $release ; + } elsif ($stage eq "chip") { + + # Check to see if we're using dynamic masks + my $dynamicMasks; # Use dynamic masks? + { + # Get the PSASTRO recipe + my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + # note verbose == 0 to avoid polluting log files with almost always useless information + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $magic_ds_id, $component, + $PS_EXIT_CONFIG_ERROR); + } + my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $magic_ds_id, $component, + $PS_EXIT_CONFIG_ERROR); + + $dynamicMasks = metadataLookupBool($recipeData, 'REFSTAR_MASK'); + } + + # we use the mask output from the camera stage for input and replace + # the output of the chip stage with that mask as well. + $image = $ipprc->filename("PPIMAGE.CHIP", $path_base, $class_id); + $weight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $path_base, $class_id); + $astrom = $ipprc->filename("PSASTRO.OUTPUT", $cam_path_base); + + # if magicked is non-zero we are updating a previously magicked component. In this case we don't + # touch the camera mask + if (!$magicked and $dynamicMasks) { + $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $cam_path_base, $class_id); + $ch_mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $path_base, $class_id); + } else { + $mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $path_base, $class_id); + } + + # only destreak cmf file if this is a new run + if ($run_state eq 'new') { + $sources = $ipprc->filename("PSPHOT.OUTPUT", $path_base, $class_id); + } + + } elsif ($stage eq "chip_bg") { + $image = $ipprc->filename("PPBACKGROUND.OUTPUT", $path_base, $class_id); + $mask = $ipprc->filename("PPBACKGROUND.OUTPUT.MASK", $path_base, $class_id); + $astrom = $ipprc->filename("PSASTRO.OUTPUT", $cam_path_base); + } elsif ($stage eq "warp" or $stage eq "warp_bg") { + $image = $ipprc->filename("PSWARP.OUTPUT", $path_base); + $mask = $ipprc->filename("PSWARP.OUTPUT.MASK", $path_base); + $weight = $ipprc->filename("PSWARP.OUTPUT.VARIANCE", $path_base); + $sources = $ipprc->filename("PSWARP.OUTPUT.SOURCES", $path_base); + } elsif ($stage eq "diff") { + $image = $ipprc->filename("PPSUB.OUTPUT", $path_base); + $mask = $ipprc->filename("PPSUB.OUTPUT.MASK", $path_base); + $weight = $ipprc->filename("PPSUB.OUTPUT.VARIANCE", $path_base); + $sources = $ipprc->filename("PPSUB.OUTPUT.SOURCES", $path_base); + + if ($inv_streaks_resolved) { + # create a temporary file containing the contents of the + # two streaks files + ($allstreaks_fh, $allstreaks_name) = tempfile ("/tmp/all.streaks.XXXX", + UNLINK => !$save_temps); + + combine_streaks($allstreaks_fh, $streaks_resolved, $inv_streaks_resolved); + + # apply the combined streaks to both the forward and inverse diffs + $streaks_resolved = $allstreaks_name; + } + } + + { + my $command = "$streaksremove -stage $stage -tmproot $tmproot -streaks $streaks_resolved -image $image"; + + $command .= " -stats $statsFile"; + $command .= " -class_id $class_id" if defined $class_id; + $command .= " -recovery $recoveryroot" if defined $recoveryroot; + $command .= " -astrom $astrom" if defined $astrom; + $command .= " -mask $mask" if defined $mask; + $command .= " -chip_mask $ch_mask" if defined $ch_mask; + $command .= " -weight $weight" if defined $weight; + $command .= " -sources $sources" if defined $sources; + $command .= " -skycelllist $skycell_list" if defined $skycell_list; + $command .= " -replace" if $replace; + $command .= " -release" if $release; + $command .= " -dbname $dbname" if defined $dbname; + unless (defined $no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform streaksremove: $error_code", $magic_ds_id, $component, $error_code); + } + } else { + print "skipping command $command\n"; + } + } + if (($stage eq "diff") and $inv_streaks_resolved) { + $image = $ipprc->filename("PPSUB.INVERSE", $path_base); + $mask = $ipprc->filename("PPSUB.INVERSE.MASK", $path_base); + $weight = $ipprc->filename("PPSUB.INVERSE.VARIANCE", $path_base); + $sources = $ipprc->filename("PPSUB.INVERSE.SOURCES", $path_base); + + # Note: we create a stats file for the inverse procesing but we don't look at the results + my $invStatsFile = "$outroot/$exp_id.mds.$magic_ds_id.$stage_id.$component.inv.stats"; + + my $command = "$streaksremove -stage $stage -tmproot $tmproot -streaks $streaks_resolved -image $image"; + $command .= " -stats $invStatsFile"; + + $command .= " -recovery $recoveryroot" if defined $recoveryroot; + $command .= " -mask $mask" if defined $mask; + $command .= " -weight $weight" if defined $weight; + $command .= " -sources $sources" if defined $sources; + $command .= " -replace" if $replace; + $command .= " -release" if $release; + $command .= " -dbname $dbname" if defined $dbname; + unless (defined $no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform streaksremove: $error_code", $magic_ds_id, $component, $error_code); + } + } else { + print "skipping command $command\n"; + } + } +} else { + # camera stage. The only work to do is to censor the detections file + + my $tempOutRoot = "/tmp/destreak"; + my ($maskListFile, $maskListName) = tempfile( "$tempOutRoot.mask.list.XXXX", UNLINK => !$save_temps); + my $files; + { + my $cam_id = $stage_id; + my $command = "$camtool -pendingimfile -cam_id $cam_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform camtool: $error_code", $cam_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $cam_id, $PS_EXIT_PROG_ERROR); + + # extract the metadata for the files into a hash list + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $cam_id, $PS_EXIT_PROG_ERROR); + } + foreach my $file (@$files) { + my $class_id = $file->{class_id}; + my $quality = $file->{quality}; + if (!$quality) { + my $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $path_base, $class_id); + if (! $ipprc->file_exists($mask)) { + # camera mask doesn't exist for this chip. Fall back to the chip mask + $mask= $ipprc->filename("PPIMAGE.CHIP.MASK", $file->{path_base}, $class_id); + } + print $maskListFile "$mask\n"; + } + } + close $maskListFile; + + my $astrom = $ipprc->filename("PSASTRO.OUTPUT", $path_base); + { + my $command = "$censorObjects -file $astrom -masklist $maskListName $backup_path_base"; + # $command .= " -replace" if $replace; + $command .= " -dbname $dbname" if defined $dbname; + unless (defined $no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform censorObjects: $error_code", $magic_ds_id, $component, $error_code); + } + my $output = $ipprc->filename("CENSOR.OUTPUT", $backup_path_base); + &my_die("expected output file $output not found ", $magic_ds_id, $component, $PS_EXIT_DATA_ERROR) + unless $ipprc->file_exists($output); + + if ($replace) { + $nebulous->swap($astrom, $output) or + &my_die("nebulous swap failed $astrom $output", $magic_ds_id, $component, $PS_EXIT_UNKNOWN_ERROR); + } + } else { + print "skipping command $command\n"; + } + } +} + +my $statsFlags; +if (!$no_op and $stage ne "camera") { + file_check($statsFile); + { + my $resolvedStatsFile = $ipprc->file_resolve($statsFile); + my $command = "$ppStatsFromMetadata $resolvedStatsFile - STREAKSREMOVE"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $magic_ds_id, $component, $error_code); + } + foreach my $line (@$stdout_buf) { + $statsFlags .= " $line"; + } + chomp $statsFlags; + } +} + +# XXX: if recovery and/or backup files were expected make sure they exist + +# Input result into database +{ + my $command = "$magicdstool"; + $command .= " -magic_ds_id $magic_ds_id"; + $command .= " -component $component"; + $command .= " -setmagicked" if $replace; + if ($run_state eq 'new') { + $command .= " -adddestreakedfile"; + $command .= " -backup_path_base $backup_path_base" if $backup_path_base; + $command .= " -recovery_path_base $recovery_path_base" if $recovery_path_base; + $command .= " $statsFlags" if $statsFlags; + } else { + $command .= " -tofullfile"; + } + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magicdstool -addresult: $error_code", $magic_ds_id, $component, + $error_code); + } + } else { + print "Skipping command: $command\n"; + } +} + + + +### Pau. + + +sub file_check +{ + my $file = shift; # Name of file + &my_die("Unable to find output file: $file", $magic_ds_id, $component, $PS_EXIT_SYS_ERROR) unless + $ipprc->file_exists($file); +} + +sub inNebulous +{ + my $path = shift; + + my $scheme = file_scheme($path); + + return $scheme and ($scheme eq "neb"); +} + +sub combine_streaks +{ + my $fout = shift; + my $fn1 = shift; + my $fn2 = shift; + + my ($n1, @streaks1) = read_streaks_file($fn1); + my_die("failed to read streaks from $fn1", $magic_ds_id, $component, + $PS_EXIT_UNKNOWN_ERROR) if $n1 < 0; + + my ($n2, @streaks2) = read_streaks_file($fn2); + my_die("failed to read streaks from $fn2", $magic_ds_id, $component, + $PS_EXIT_UNKNOWN_ERROR) if $n2 < 0; + + print $fout $n1 + $n2 . "\n"; + + foreach my $line (@streaks1, @streaks2) { + print $fout $line; + } + + close $fout + or my_die("failed to close combined streaks file", $magic_ds_id, + $component, $PS_EXIT_UNKNOWN_ERROR); +} + +sub read_streaks_file +{ + my $filename = shift; + my $fh; + open $fh, "<$filename" or my_die("failed to open $filename", + $magic_ds_id, $component, $PS_EXIT_UNKNOWN_ERROR); + + # first line is the number of streaks + my $line = <$fh>; + chomp $line; + my $nstreaks = $line; + + my @streaks; + + foreach $line (<$fh>) { + push @streaks, $line; + } + + close $fh; + + return ($nstreaks, @streaks); +} + + # @diff_components = get_overlaps($path_base, $component, $tess_id, $diff_tess_id); +sub get_overlaps { + my $path_base = shift; + my $component = shift; + my $diff_tess_id = shift; + + my $tess_dir = $ipprc->tessellation_catdir( $diff_tess_id ); + my $catdir = $ipprc->convert_filename_absolute($tess_dir); + + my $cmf = $ipprc->file_resolve("$path_base.cmf"); + &my_die("Unable to resolve $path_base.$cmf", $magic_ds_id, $component, $PS_EXIT_SYS_ERROR) unless $cmf; + + my $command = "$dvoImageOverlaps -D CATDIR $catdir -accept-astrom $cmf"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dvoImageOverlaps $error_code", $magic_ds_id, $component, + $error_code); + } + my @list; + my $output = join "\n", @$stdout_buf; + if ($output) { + foreach my $line (split "\n", $output) { + my (undef, undef, $skycell_id) = split " ", $line; + push @list, $skycell_id; + } + } + return @list +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $magic_ds_id = shift; # Magic DS identifier + my $component = shift; # class_id or skycell_id + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + my $command = "$magicdstool"; + + if ($run_state eq 'new') { + $command .= " -adddestreakedfile"; + } else { + $command .= " -updatedestreakedfile"; + } + $command .= " -magic_ds_id $magic_ds_id"; + $command .= " -component $component"; + $command .= " -backup_path_base $backup_path_base" if $backup_path_base; + $command .= " -recovery_path_base $recovery_path_base" if $recovery_path_base; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_ds_id $component"); + } + } else { + print "Skipping command: $command\n"; + } + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_cleanup.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_cleanup.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_cleanup.pl (revision 41105) @@ -0,0 +1,298 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename dirname ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); +use Nebulous::Client; +use DBI; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($magic_ds_id, $camera, $stage); +my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile); + +GetOptions( + 'magic_ds_id=s' => \$magic_ds_id,# Magic destreak run identifier + 'camera=s' => \$camera, # camera for evaluating file rules + 'stage=s' => \$stage, # ipp stage for this magicDSRun + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --magic_ds_id --camera", + -exitval => 3) unless + defined $magic_ds_id and + defined $camera and + defined $stage; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_ds_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$ipprc->redirect_to_logfile($logfile) or my_die( "Unable to redirect output", $magic_ds_id, $PS_EXIT_SYS_ERROR ) if $logfile; + + +$dbname = metadataLookupStr( $ipprc->{_siteConfig}, 'DBNAME' ) if !$dbname; +&my_die ("Unable to find DBNAME in site or command line arguments", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if !$dbname; + +my $dbuser = metadataLookupStr( $ipprc->{_siteConfig}, 'DBUSER' ); +&my_die ("Unable to find DBUSER in site", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if !$dbuser; + +my $dbpassword = metadataLookupStr( $ipprc->{_siteConfig}, 'DBPASSWORD' ); +&my_die ("Unable to find DBPASSWORD in site", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if !$dbpassword; + +my $dbserver = metadataLookupStr( $ipprc->{_siteConfig}, 'DBSERVER' ); +&my_die ("Unable to find DBSERVER in site", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if !$dbserver; + +my $dsn = "DBI:mysql:host=$dbserver;database=$dbname"; +my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) or die "Cannot connect to mysql server\n"; + +my $q1; + +if ($stage ne 'diff') { + $q1 = "SELECT magicDSRun.*, camera, camProcessedExp.path_base AS cam_path_base, camRun.reduction AS cam_reduction" + . " FROM magicDSRun JOIN magicRun USING(magic_id) JOIN rawExp USING(exp_id) LEFT JOIN camProcessedExp USING(cam_id) LEFT JOIN camRun USING(cam_id)"; +} else { + $q1 = "SELECT magicDSRun.*, diffRun.diff_mode FROM magicDSRun JOIN diffRun ON stage_id = diffRun.diff_id AND stage = 'diff'"; +} +$q1 .= " WHERE magic_ds_id = $magic_ds_id"; + +my $q2 = "SELECT * from magicDSFile WHERE (data_state = 'full' OR data_state = 'update') AND magic_ds_id = $magic_ds_id"; + +my $stmt1 = $dbh->prepare($q1); +$stmt1->execute(); +my $nrows = $stmt1->rows; +&my_die ("Unable to find magicDSRun $magic_ds_id", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if !$nrows; +my $run = $stmt1->fetchrow_hashref(); +$stmt1->finish(); + +my $state = $run->{state}; +my $stage_id = $run->{stage_id}; +my $cam_path_base = $run->{cam_path_base}; +my $cam_reduction = $run->{cam_reduction}; +my $replace = $run->{re_place}; +$cam_reduction = 'DEFAULT' if !$cam_reduction or ($cam_reduction eq 'NULL'); + +my $warp_warp = ($stage eq 'diff' and $run->{diff_mode} eq 1); + + +&my_die("cleanup not supported for camera stage", $magic_ds_id, $PS_EXIT_PROG_ERROR) if $stage eq "camera"; + + +&my_die("unexpected run state found: $state", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if $state ne "goto_cleaned"; +&my_die("cleanup not allowed for raw stage, use goto_restore", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) if $stage eq "raw" and $replace; + +my $recipe_psastro; +if ($stage eq 'chip') { + $recipe_psastro = $ipprc->reduction($cam_reduction, 'PSASTRO'); # Recipe to use + &my_die("Unrecognised PSASTRO recipe", $magic_ds_id, $PS_EXIT_CONFIG_ERROR) unless defined $recipe_psastro; +} + + +my $stmt2 = $dbh->prepare($q2); +$stmt2->execute(); + +my $num_components = 0; +my @components; +# save the data, so we can disconnect from the database +# deleting can take awhile +while (my $comp = $stmt2->fetchrow_hashref()) { + push @components, $comp; + $num_components++; +} +if ($num_components == 0) { + # no components to clean up set run state to cleaned + my $command = "$magicdstool -updaterun -magic_ds_id $magic_ds_id -set_state cleaned"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_ds_id"); + } + } else { + print "Skipping command: $command\n"; + } + exit 0; +} + +$stmt2->finish(); +$dbh->disconnect() or warn $dbh->errstr; + +# We no longer clean up the camera stage mask files, but the code was left in place in case +# we change our minds. +my $cleanup_cam_mask = 0; + +my $dynamicMasks; # Use dynamic masks? +foreach my $comp (@components) { + my $component = $comp->{component}; + my $backup_path_base = $comp->{backup_path_base}; + my ($bimage, $bmask, $bch_mask, $bweight, $bsources, $bastrom); +# my ($rimage, $rmask, $rch_mask, $rweight, $rsources, $rastrom); + + if ($stage eq "chip") { + # Check to see if we're using dynamic masks + if ($cleanup_cam_mask && !defined $dynamicMasks) { + # Get the PSASTRO recipe + my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $magic_ds_id, $component, + $PS_EXIT_CONFIG_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $magic_ds_id, $component, + $PS_EXIT_CONFIG_ERROR); + + $dynamicMasks = metadataLookupBool($recipeData, 'REFSTAR_MASK'); + } + + if ($backup_path_base) { + $bimage = $ipprc->filename("PPIMAGE.CHIP", $backup_path_base, $component); + + if ($dynamicMasks) { + my $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $cam_path_base, $component); + # This is kludgey but correct + $bmask = dirname($backup_path_base) . "/SR_" . basename($mask); + $bch_mask= $ipprc->filename("PPIMAGE.CHIP.MASK", $backup_path_base, $component); + } else { + $bmask = $ipprc->filename("PPIMAGE.CHIP.MASK", $backup_path_base, $component); + } + $bweight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $backup_path_base, $component); + $bsources = $ipprc->filename("PSPHOT.OUTPUT", $backup_path_base, $component); + } + } elsif ($stage eq "camera") { + if ($backup_path_base) { + $bastrom = $ipprc->filename("PSASTRO.OUTPUT", $backup_path_base); + } + } elsif ($stage eq "warp") { + if ($backup_path_base) { + $bimage = $ipprc->filename("PSWARP.OUTPUT", $backup_path_base); + $bmask = $ipprc->filename("PSWARP.OUTPUT.MASK", $backup_path_base); + $bweight = $ipprc->filename("PSWARP.OUTPUT.VARIANCE", $backup_path_base); + $bsources = $ipprc->filename("PSWARP.OUTPUT.SOURCES", $backup_path_base); + } + } elsif ($stage eq "diff") { + my $name = "PPSUB.OUTPUT"; + if ($backup_path_base) { + $bimage = $ipprc->filename($name, $backup_path_base); + $bmask = $ipprc->filename("$name.MASK", $backup_path_base); + $bweight = $ipprc->filename("$name.VARIANCE", $backup_path_base); + # bills 2011-01-24 + # don't clean up the uncensored Diff sources file + # $bsources = $ipprc->filename("$name.SOURCES", $backup_path_base); + } + } elsif ($stage eq "raw") { + if ($backup_path_base) { + if ($backup_path_base =~ /fits/) { + $bimage = $backup_path_base; + } else { + $bimage = $backup_path_base . ".fits"; + } + } + } + + delete_files($bimage, $bmask, $bweight, $bsources, $bastrom, $bch_mask); + + if ($stage eq "diff" and $warp_warp) { + my $name = "PPSUB.INVERSE"; + if ($backup_path_base) { + $bimage = $ipprc->filename($name, $backup_path_base); + $bmask = $ipprc->filename("$name.MASK", $backup_path_base); + $bweight = $ipprc->filename("$name.VARIANCE", $backup_path_base); + # bills 2011-01-24 + # don't clean up the uncensored sources file + # $bsources = $ipprc->filename("$name.SOURCES", $backup_path_base); + } + delete_files($bimage, $bmask, $bweight, $bsources); + } + my $command = "$magicdstool -tocleanedfile -magic_ds_id $magic_ds_id -component $component"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_ds_id"); + } + } else { + print "Skipping command: $command\n"; + } +} + +### Pau. + +sub delete_files { + foreach my $file (@_) { + if ($file) { + my $error_code = $ipprc->kill_file($file); + my_die("Failed to delete $file", $magic_ds_id, $error_code) if $error_code; + } + } +} + + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $magic_ds_id = shift; # Magic DS identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + my $command = "$magicdstool -updaterun -set_state error_cleaned"; + $command .= " -magic_ds_id $magic_ds_id"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_ds_id"); + } + } else { + print "Skipping command: $command\n"; + } + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_defineruns.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_defineruns.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_defineruns.pl (revision 41105) @@ -0,0 +1,108 @@ +#!/usr/bin/env perl +# +# dist_defineruns.pl : run magicdstool -definebyquery for the various stages +# + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Digest::MD5::File qw( file_md5_hex ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Look for programs we need +my $missing_tools; +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($stage, $stage_limit, $workdir, $recoveryroot); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); +my @labels; + +GetOptions( + 'stage=s' => \$stage, # stage to queue + 'label=s' => \@labels, # labels + 'stage_limit=s' => \$stage_limit,# maximum number of runs queued for each stage + 'workdir=s' => \$workdir, # output destination + 'recoveryroot=s' => \$recoveryroot, # recovery pixels destination + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database + 'save-temps' => \$save_temps, # Save temporary files? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --label --workdir", + -exitval => 3) unless + (scalar @labels > 0) and + defined $workdir; + +$ipprc->redirect_output($logfile) if $logfile; + +# if stage is not supplied as an argument, loop over all stages +my @stages; +if ($stage) { + push @stages, $stage; +} else { + # raw is omitted for now + @stages = qw( chip camera warp diff ); +} + +foreach my $stage (@stages) { + foreach my $label (@labels) { + my $command = "$magicdstool -definebyquery -stage $stage -workdir $workdir -label $label"; + $command .= " -recoveryroot $recoveryroot" if $recoveryroot; + $command .= " -pretend" if $no_update; + $command .= " -limit $stage_limit" if $stage_limit; + $command .= " -set_label $label"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $error_code); + } + # display the output from the command + print STDERR join "", @$stdout_buf if $verbose; + } +} + +exit 0; + +sub my_die { + my $msg = shift; + my $fault = shift; + + print STDERR "$msg\n"; + + exit $fault; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_revert.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_revert.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_destreak_revert.pl (revision 41105) @@ -0,0 +1,534 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print STDERR "\n\n"; +print STDERR "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename dirname ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); +use Nebulous::Client; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +my $isdestreaked = can_run('isdestreaked') or (warn "Can't find isdestreaked" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($magic_ds_id, $camera, $streaks, $stage, $stage_id, $component, $uri, $path_base, $bothways, $cam_path_base, $cam_reduction, $magicked, $run_state); +my ($outroot, $recovery_path_base, $replace, $release, $bytes, $md5sum); +my ($dbname, $save_temps, $verbose, $no_update, $no_op, $logfile); + +GetOptions( + 'magic_ds_id=s' => \$magic_ds_id,# Magic destreak run identifier + 'camera=s' => \$camera, # camera for evaluating file rules + 'stage=s' => \$stage, # raw, chip, warp, or diff + 'stage_id=s' => \$stage_id, # exp_id, chip_id, warp_id, or diff_id + 'run-state=s' => \$run_state, # current state of run + 'component=s' => \$component, # the class_id or skycell_id + 'path_base=s' => \$path_base, # path_base of the input + 'cam_path_base=s'=> \$cam_path_base, # path_base of the associated camera run + 'cam_reduction=s'=> \$cam_reduction, # reduction class of the associated camera run + 'outroot=s' => \$outroot, # "directory" for temporary images (may be nebulous) + 'recovery_path_base=s' => \$recovery_path_base,# "directory" for saving the images of excised pixels + 'replace=s' => \$replace, # replace the input images with the results. + 'bothways=s' => \$bothways, # run has inverse files (bothways diff) + 'magicked=s' => \$magicked, # magicked state of the run + 'save-temps' => \$save_temps, # Save temporary files? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --magic_ds_id --camera --stage --stage_id --component --path_base --outroot --magicked", + -exitval => 3) unless + defined $magic_ds_id and + defined $camera and + defined $stage and + defined $stage_id and + defined $component and + defined $path_base and + defined $magicked and + defined $run_state and + defined $outroot; + +if (defined($replace) and ($replace eq "T")) { + $replace = 1; +} else { + $replace = 0; +} + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +$ipprc->redirect_to_logfile($logfile) or my_die( "Unable to redirect output", $magic_ds_id, $component, $PS_EXIT_SYS_ERROR ) if $logfile; + +&my_die("bytes and md5sum are is required for raw stage stage", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) if ($replace and $stage eq 'raw' and (!$bytes or !$md5sum)); + +&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); + + + + +$cam_reduction = 'DEFAULT' if !defined $cam_reduction or ($cam_reduction eq "NULL"); +my $recipe_psastro = $ipprc->reduction($cam_reduction, 'PSASTRO'); # Recipe to use +&my_die("Unrecognised PSASTRO recipe", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) unless defined $recipe_psastro; + +my $nebulousServer = metadataLookupStr( $ipprc->{_siteConfig}, 'NEB_SERVER' ); +&my_die("cannot find NEB_SERVER in site configuration", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) if !$nebulousServer; + +my $nebulous = eval { Nebulous::Client->new( proxy => $nebulousServer ); }; +if ($@ or not defined $nebulous) { + &my_die ("Unable to create a Nebulous::Client object with proxy $nebulousServer", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); +} + + +my $class_id; +my $skycell_id; +if (($stage eq "raw") or ($stage eq "chip")) { + $class_id = $component; +} elsif ($stage eq "warp") { + $skycell_id = $component; +} elsif ($stage eq "diff") { + $skycell_id = $component; +} elsif ($stage ne "camera") { + &my_die("Invalid value for stage: $stage", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my $dirname = dirname($path_base); +my $basename = basename($path_base); +my $nebulousInput = inNebulous($dirname); + +&my_die("replace not allowed for non-nebulous files", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR) + if ($replace eq "T") and !$nebulousInput; + + +# default value is "NULL" do not use it +if (defined($recovery_path_base) and ($recovery_path_base eq "NULL")) { + $recovery_path_base = undef; +} + +my $backup_path_base; +my $tmproot; +if ($replace) { + # in replace mode, we place the output files in the same "directory" as the inputs + # Nebulous requires this for the two inputs to nebSwap which we use + # We prepend the path with SR_ This causes the filenames for instances of the swapped files to + # have SR in them. + $tmproot = $dirname . "/SR_"; + $backup_path_base = $tmproot . "$basename"; +} else { + # note: the trailing / here is necessary + $tmproot = "$outroot/"; + $backup_path_base = $tmproot . $basename; +} + + +my ($image, $mask, $ch_mask, $weight, $sources, $astrom); +my ($bimage, $bmask, $bch_mask, $bweight, $bsources, $bastrom); +my ($rimage, $rmask, $rch_mask, $rweight); + +if ($stage eq "raw") { + if ($path_base =~ /.*\.fits$/) { + # removal of uri from rawImfile hasn't happened yet + $image = $path_base; + } else { + # XXX: should have a file rule + $image = $path_base . ".fits"; + } + if ($backup_path_base =~ /.*\.fits$/) { + $bimage = $backup_path_base; + } else { + $bimage = $backup_path_base . ".fits"; + } +} elsif ($stage eq "chip") { + # Check to see if we're using dynamic masks + my $dynamicMasks; # Use dynamic masks? + { + # Get the PSASTRO recipe + my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + # note verbose == 0 to keep from polluting log file with lots of usually useless information + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $magic_ds_id, $component, + $PS_EXIT_CONFIG_ERROR); + } + my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $magic_ds_id, $component, + $PS_EXIT_CONFIG_ERROR); + + $dynamicMasks = metadataLookupBool($recipeData, 'REFSTAR_MASK'); + } + + $image = $ipprc->filename("PPIMAGE.CHIP", $path_base, $class_id); + $weight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $path_base, $class_id); + + # we use the mask output from the camera stage for input and replace + # the output of the chip stage with that mask as well. + # Note that when destreaking as part of an update $magicked is non-zero. + # In this case we do not touch the camera stage mask so there is no need to revert it + if ($dynamicMasks and (!$magicked or ($run_state eq 'goto_restored'))) { + $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $cam_path_base, $class_id); + $ch_mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $path_base, $class_id); + } else { + $mask = $ipprc->filename("PPIMAGE.CHIP.MASK", $path_base, $class_id); + } + + # only revert sources if this is a new run, not one being updated + if (($run_state eq 'new') or ($run_state eq 'goto_restored')) { + $sources = $ipprc->filename("PSPHOT.OUTPUT", $path_base, $class_id); + $bsources = $ipprc->filename("PSPHOT.OUTPUT", $backup_path_base, $class_id); + } + + $bimage = $ipprc->filename("PPIMAGE.CHIP", $backup_path_base, $class_id); + # This is somewhat kludgey but it works whether the mask is camera mask or chip mask + $bmask = dirname($backup_path_base) . "/SR_" . basename($mask); + $bch_mask= $ipprc->filename("PPIMAGE.CHIP.MASK", $backup_path_base, $class_id); + $bweight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $backup_path_base, $class_id); + + if ($recovery_path_base) { + $rimage = $ipprc->filename("PPIMAGE.CHIP", $recovery_path_base, $class_id); + # This is somewhat kludgey but it works whether the mask is camera mask or chip mask + $rmask = dirname($recovery_path_base) . "/REC_" . basename($mask); + $rch_mask= $ipprc->filename("PPIMAGE.CHIP.MASK", $recovery_path_base, $class_id); + $rweight = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $recovery_path_base, $class_id); + } +} elsif ($stage eq "camera") { + $astrom = $ipprc->filename("PSASTRO.OUTPUT", $path_base); + $bastrom = $ipprc->filename("PSASTRO.OUTPUT", $backup_path_base); +} elsif ($stage eq "warp") { + $image = $ipprc->filename("PSWARP.OUTPUT", $path_base); + $mask = $ipprc->filename("PSWARP.OUTPUT.MASK", $path_base); + $weight = $ipprc->filename("PSWARP.OUTPUT.VARIANCE", $path_base); + $sources = $ipprc->filename("PSWARP.OUTPUT.SOURCES", $path_base); + $bimage = $ipprc->filename("PSWARP.OUTPUT", $backup_path_base); + $bmask = $ipprc->filename("PSWARP.OUTPUT.MASK", $backup_path_base); + $bweight = $ipprc->filename("PSWARP.OUTPUT.VARIANCE", $backup_path_base); + $bsources = $ipprc->filename("PSWARP.OUTPUT.SOURCES", $backup_path_base); + if ($recovery_path_base) { + $rimage = $ipprc->filename("PSWARP.OUTPUT", $recovery_path_base); + $rmask = $ipprc->filename("PSWARP.OUTPUT.MASK", $recovery_path_base); + $rweight = $ipprc->filename("PSWARP.OUTPUT.VARIANCE", $recovery_path_base); + } +} elsif ($stage eq "diff") { + my $name = "PPSUB.OUTPUT"; + $image = $ipprc->filename($name, $path_base); + $mask = $ipprc->filename("$name.MASK", $path_base); + $weight = $ipprc->filename("$name.VARIANCE", $path_base); + $sources = $ipprc->filename("$name.SOURCES", $path_base); + $bimage = $ipprc->filename($name, $backup_path_base); + $bmask = $ipprc->filename("$name.MASK", $backup_path_base); + $bweight = $ipprc->filename("$name.VARIANCE", $backup_path_base); + $bsources = $ipprc->filename("$name.SOURCES", $backup_path_base); + if ($recovery_path_base) { + $rimage = $ipprc->filename($name, $recovery_path_base); + $rmask = $ipprc->filename("$name.MASK", $recovery_path_base); + $rweight = $ipprc->filename("$name.VARIANCE", $recovery_path_base); + } +} + +revert_files($replace, $image, $mask, $weight, $sources, $astrom, $bimage, $bmask, $bweight, $bsources, $bastrom); +if ($recovery_path_base) { + delete_recovery_files($rimage, $rmask, $rweight, $rch_mask); +} + +if ($stage eq "diff" and $bothways) { + my $name = "PPSUB.INVERSE"; + $image = $ipprc->filename($name, $path_base); + $mask = $ipprc->filename("$name.MASK", $path_base); + $weight = $ipprc->filename("$name.VARIANCE", $path_base); + $sources = $ipprc->filename("$name.SOURCES", $path_base); + $bimage = $ipprc->filename($name, $backup_path_base); + $bmask = $ipprc->filename("$name.MASK", $backup_path_base); + $bweight = $ipprc->filename("$name.VARIANCE", $backup_path_base); + $bsources = $ipprc->filename("$name.SOURCES", $backup_path_base); + revert_files($replace, $image, $mask, $weight, $sources, undef, $bimage, $bmask, $bweight, $bsources, undef); + if ($recovery_path_base) { + $rimage = $ipprc->filename($name, $recovery_path_base); + $rmask = $ipprc->filename("$name.MASK", $recovery_path_base); + $rweight = $ipprc->filename("$name.VARIANCE", $recovery_path_base); + delete_recovery_files($rimage, $rmask, $rweight); + } +} + +# now revert the row in the database +{ + my $command = "$magicdstool -revertdestreakedfile -i_am_sure"; + $command .= " -state $run_state"; + $command .= " -magic_ds_id $magic_ds_id"; + $command .= " -component $component"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magicdstool -addresult: $error_code", $magic_ds_id, $component, + $error_code); + } + } else { + print "Skipping command: $command\n"; + } +} + + +### Pau. + +sub revert_files { + my $replace = shift; +# return if !$replace; + + my $image = shift; + my $mask = shift; + my $weight = shift; + my $sources = shift; + my $astrom = shift; + my $bimage = shift; + my $bmask = shift; + my $bweight = shift; + my $bsources = shift; + my $bastrom = shift; + + if ($image) { + revert_file($replace, $image, $bimage) or + &my_die("failed to restore image file", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); + } + + if ($mask) { + if (!revert_file($replace, $mask, $bmask)) { + &my_die("failed to restore mask file", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); + } + } + + if ($ch_mask) { + if (!revert_file($replace, $ch_mask, $bch_mask)) { + &my_die("failed to restore chip mask file", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); + } + } + + + if ($weight) { + revert_file($replace, $weight, $bweight) or + &my_die("failed to restore variance image", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); + } + + if ($sources) { + revert_file($replace, $sources, $bsources) or + &my_die("failed to restore sources file", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); + } + + if ($astrom) { + revert_file($replace, $astrom, $bastrom) or + &my_die("failed to restore astrometry file", $magic_ds_id, $component, $PS_EXIT_CONFIG_ERROR); + } +} + +sub check_keyword +{ + my $filename = shift; + my $command = "$isdestreaked $filename"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + if (!defined $error_code) { + print STDERR "run( $command ) returned undef error_code!!!!!\n"; + return $PS_EXIT_UNKNOWN_ERROR; + } + return $error_code >> 8; +} + +sub revert_file +{ + my $replace = shift; + my $original = shift; + my $backup = shift; + my $force = 1; # force deletion of backup files in nebulous + + if (!$replace) { + # we don't need to do all of this checking unless the destreak run is + # replace mode just delete the backup + my $error_code = $ipprc->kill_file($backup); + if ($error_code) { + print STDERR "failed to kill $backup: error_code $error_code\n"; + return 0; + } else { + return 1; + } + } + + my $o_path = $ipprc->file_resolve($original); + my $original_result; + if ($o_path) { + # invoke the program isdestreaked to check for the destreaked keyword + $original_result = check_keyword($o_path); + } else { + print STDERR "no instances found for $original\n"; + $original_result = $PS_EXIT_DATA_ERROR; + } + my $original_is_destreaked = $original_result eq 0; + my $original_is_not_destreaked = $original_result eq 42; + + my $b_path = $ipprc->file_resolve($backup); + my $backup_result; + if ($b_path) { + $backup_result = check_keyword($b_path); + } else { + print STDERR "no instances found for $backup\n"; + $backup_result = $PS_EXIT_DATA_ERROR; + } + my $backup_is_destreaked = $backup_result eq 0; + my $backup_is_not_destreaked = $backup_result eq 42; + + if ($backup_is_not_destreaked) { + if ($original_is_not_destreaked) { + print STDERR "\nBoth files appear to not be destreaked.\n"; + print STDERR "original: $original\n"; + print STDERR "backup: $backup\n"; + my $o_basename = basename($o_path); + my $b_basename = basename($b_path); + # if original file does not have SR_ in basename and the backup does then the + # files are in their original state. Just delete back up file + # otherwise go to failed_revert for manual inspection. + # XXX: We probably can get by with just checking the basename of the original file + if (!($o_basename =~ /SR_/) ) { + # if (!($o_basename =~ /SR_/) and ($b_basename =~ /SR_/)) { + print STDERR " basenames are as expected it is safe to delete backup file\n"; + if (! $ipprc->file_delete($backup, $force)) { + print STDERR "failed to delete $backup\n"; + return 0; + } + return 1; + } else { + # this is an unexpected result. throw an error so this can be checked manually + print STDERR " basenames for files are as NOT as expected unsafe to revert\n"; + print STDERR " o_basename: $o_basename\n"; + print STDERR " b_basename: $b_basename\n"; + return 0; + } + } + # XXX TODO if stage is raw, check that backup has the correct size and md5sum + + if ($verbose) { + print "ready to swap $backup\n"; + print " to $original\n"; + } + # Do we need to make this test? After the swap we're going to delete the file anyways + + if (! $nebulous->swap($backup, $original)) { + print "failed to swap $backup\n"; + print " to $original\n"; + return 0; + } + + if ($b_path) { + print "ready to delete backup\n" if $verbose; + if (! $ipprc->file_delete($backup, $force)) { + print "failed to delete $backup\n"; + return 0; + } + } + + } elsif ($original_is_not_destreaked) { + print "original uri: $original is not a destreaked file no need to swap backup_result: $backup_result\n"; + # delete the 'backup' (destreaked target) file if it exists + if ($b_path) { + if (! $ipprc->file_delete($backup, $force)) { + print "failed to delete $backup\n"; + return 0; + } + } + } else { + print STDERR "Error: neither file is an un de-streaked file.\n"; + print STDERR " backup key: $backup status: $backup_result\n"; + print STDERR " original key: $original status $original_result\n"; + return 0; + } + return 1; +} + + +sub delete_recovery_files +{ + foreach my $file (@_) { + next if !$file; + # don't care if this fails or not (it will fail if storage + # object doesn't exist + $ipprc->kill_file($file); + } +} + +sub inNebulous +{ + my $path = shift; + + my $scheme = file_scheme($path); + + return $scheme and ($scheme eq "neb"); +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $magic_ds_id = shift; # Magic DS identifier + my $component = shift; # class_id or skycell_id + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + # fault the whole run if one of the components fails to revert + my $command = "$magicdstool -updaterun"; + $command .= " -magic_ds_id $magic_ds_id"; + if ($run_state ne 'update') { + $command .= " -set_state failed_revert"; + } else { + $command .= " -set_state failed_revert_ud"; + } + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + carp("failed to update database for $magic_ds_id $component"); + } + } else { + print "Skipping command: $command\n"; + } + + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_process.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_process.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_process.pl (revision 41105) @@ -0,0 +1,617 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Copy; +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use Astro::FITS::CFITSIO qw( :constants ); +Astro::FITS::CFITSIO::PerlyUnpacking(1); + +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $magictool = can_run('magictool') or (warn "Can't find magictool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $ppSubConvolve = can_run('ppSubConvolve') or (warn "Can't find ppSubConvolve" and $missing_tools = 1); +my $detectstreaks = can_run('DetectStreaks') or (warn "Can't find DetectStreaks" and $missing_tools = 1); +my $VerifyStreaks = can_run('VerifyStreaks') or (warn "Can't find VerifyStreaks, will not produce png images"); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($magic_id, $node, $camera, $dbname, $baseroot, $save_temps, $verbose, $no_update, $no_op, $logfile, $final_outroot); + +GetOptions( + 'magic_id=s' => \$magic_id, # Magic identifier + 'node=s' => \$node, # Node name + 'camera=s' => \$camera, # Camera name + 'dbname=s' => \$dbname, # Database name + 'baseroot=s' => \$baseroot, # Output root name + 'final-outroot=s' => \$final_outroot, # location for final outputs + 'save-temps' => \$save_temps, # Save temporary files? + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --magic_id --camera --node --baseroot", + -exitval => 3) unless + defined $magic_id and + defined $node and + defined $camera and + defined $baseroot; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_id, $node, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $magic_id, $node, $PS_EXIT_SYS_ERROR ) if $logfile; + +# DetectStreaks doesn't know about nebulous. It expects to be able to +# append strings to baseroot to form valid file names. So forbid +# nebulous path in baseroot. We could relax this by change +# DetectStreaks to take all of the file names as arguments or by +# teaching it about Nebulous +if ($baseroot =~ 'neb:/') { + &my_die("DetectStreaks does not support nebulous paths in outroot", $magic_id, $node, $PS_EXIT_CONFIG_ERROR); +} + +# most filenames are of the form $baseroot.$node.*, but VerifyStreaks +# needs access to $baseroot.*, so we construct $outroot = +# $baseroot.$node in here + +# resolve any path:// or file:// in outroot +$baseroot = $ipprc->file_resolve($baseroot); +my $outroot = "$baseroot.$node"; +$ipprc->outroot_prepare($outroot); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# list of VerifyStreaks input and output files to copy to nebulous +my %verify_outputs = ( +'clusterPos.txt' => 0, +'duplicate.png' => 0, +'mask.png' => 0, +'original.png' => 0, +'original.fits' => 0, +'residual.png' => 0, +'residual.fits' => 0, +'clusters.list' => 1 +); + +### Get a list of inputs +my $inputs; # List of inputs +{ + my $command = "$magictool -inputs -magic_id $magic_id -node $node"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magictool -inputs: $error_code", $magic_id, $node, $error_code); + } + + $inputs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $magic_id, $node, $PS_EXIT_PROG_ERROR); +} + + +my @outputs; +my $inverse; # Using inverse diff? +### Do the heavy lifting +{ + my $command; # Command to execute + $command = "$detectstreaks --outroot $outroot"; + $command .= " --verbose" if $verbose; + + ### To enable debugging output: + # $command .= " --test"; + + ### per email from Paul Sydney 2010.02.11, we should use threshold of 2.35 to catch the faint streak(s) + $command .= " --threshold 2.35"; + + my @deletions; # Files to delete + if (scalar @$inputs == 1 and $node ne "root") { + # + # DetectStreaks --detect --image filename --mask maskname --weight weightname --outroot path_base + # + # Leaf node: 'detect' stage + my $innode = $$inputs[0]; # Input node + + # expected outputs for detect stage + @outputs = ("${outroot}.clusters", "${outroot}_hough.fits", "${outroot}.streaks"); + + my $diff_id = $innode->{diff_id}; + if (!$diff_id) { + &my_die("input for node has null diff_id", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + } + my ($image, $mask, $weight) = resolve_inputs($innode); + if (!defined($image) or !defined($mask) or !defined($weight)) { + &my_die("failed to resolve inputs", $magic_id, $node, $PS_EXIT_DATA_ERROR); + } + + # to run magic on a diff image, we need the convolved version + # of the corresponding TEMPLATE image + # (see diff_skycell.pl:124) + + my $diff_base = $innode->{diff_path_base}; # Base name for diff + my $tempName = $innode->{inverse} ? "PPSUB.INPUT.CONV" : "PPSUB.REF.CONV"; # File rule of interest + my $template = $ipprc->file_resolve($ipprc->filename($tempName, $diff_base)); + + # Delete the convolved products when done (we can recreate them as we need) + push @deletions, $ipprc->filename($tempName . ".MASK", $diff_base); + push @deletions, $ipprc->filename($tempName . ".VARIANCE", $diff_base); + + unless (defined $template and $ipprc->file_exists($template)) { + # Template doesn't exist (or can't be found); try to recreate it + my $tempPath = "/tmp/magic.$magic_id.$node.template"; + + my $kernel = $ipprc->filename("PPSUB.OUTPUT.KERNELS", $diff_base); # Name of kernel file + &my_die("Unable to find kernel file $kernel", $magic_id, $node, $PS_EXIT_DATA_ERROR) unless $ipprc->file_exists($kernel); + + my ($image, $mask); # Image and mask + { + my $command = "$difftool -inputskyfile -diff_id $diff_id -skycell_id $node"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + if ($innode->{inverse}) { + # Want the input because we're magicking the reference + $command .= " -input"; + } else { + # Want the reference because we're magicking the input + $command .= " -template"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to determine convolution inputs: $error_code", $magic_id, $node, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $magic_id, $node, $PS_EXIT_PROG_ERROR); + + my $inputs = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $magic_id, $node, $PS_EXIT_PROG_ERROR); + &my_die("Unexpected number of outputs", $magic_id, $node, $PS_EXIT_PROG_ERROR) unless scalar @$inputs == 1; + my $input = $$inputs[0]; + my $path = $input->{path_base}; # Path of interest + if (defined $input->{warp_id} and $input->{warp_id} > 0) { + $image = $ipprc->filename("PSWARP.OUTPUT", $path); + $mask = $ipprc->filename("PSWARP.OUTPUT.MASK", $path); + } elsif (defined $input->{stack_id} and $input->{stack_id} > 0) { + $image = $ipprc->filename("PPSTACK.UNCONV", $path); + $mask = $ipprc->filename("PPSTACK.UNCONV.MASK", $path); + } + &my_die("Unable to determine image and mask name", $magic_id, $node, $PS_EXIT_PROG_ERROR) unless defined $image and defined $mask; + } + + { + &my_die("Unable to find image and mask: $image $mask", $magic_id, $node, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($image) and $ipprc->file_exists($mask); + + my $command = "$ppSubConvolve $tempPath -image $image -mask $mask -kernel $kernel"; + $command .= " -reference" unless $innode->{inverse}; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to create template image: $error_code", $magic_id, $node, $error_code); + } + + $template = $ipprc->filename("PPSUB.INPUT.CONV", $tempPath) or &my_die("Unable to determine filename for created template", $magic_id, $node, $PS_EXIT_PROG_ERROR); + $template = $ipprc->file_resolve($template) or &my_die("Unable to resolve filename for created template", $magic_id, $node, $PS_EXIT_PROG_ERROR); + &my_die("Unable to find created template: $template", $magic_id, $node, $PS_EXIT_PROG_ERROR) unless $ipprc->file_exists($template); + } + } + + &my_die("Cannot find template", $magic_id, $node, $PS_EXIT_DATA_ERROR) unless defined $template and $ipprc->file_exists($template); + push @deletions, $template; + + $command .= " --detect --image $image --mask $mask --weight $weight -k $template"; + + # create the list of inputs used at this stage. At higher levels the + # these files will get catenated together to create the file for the subsquent stage + # this causes major file pollution, but avoids multi-level queries + # at higher level nodes. + + my ($in_fh, $input_list) = open_list_file($outroot, "input.list"); + print $in_fh "$outroot\n"; + close $in_fh; + my ($ifh, $image_list) = open_list_file($outroot, "image.list"); + print $ifh "$image\n"; + close $ifh; + my ($mfh, $mask_list) = open_list_file($outroot, "mask.list"); + print $mfh "$mask\n"; + close $mfh; + my ($wfh, $weight_list) = open_list_file($outroot, "weight.list"); + print $wfh "$weight\n"; + close $wfh; + } else { + # + # DetectStreaks --merge --inputs input.list --images image0_1.list \ + # --masks mask0_1.list --weight weights0_1.list + # --outroot outroot + + # Branch node: 'merge' stage + + # expected outputs from merge stage + @outputs = ("${outroot}.streaks"); + + my ($in_fh, $input_list) = open_list_file($outroot, "input.list"); + my ($ifh, $image_list) = open_list_file($outroot, "image.list"); + my ($mfh, $mask_list) = open_list_file($outroot, "mask.list"); + my ($wfh, $weight_list) = open_list_file($outroot, "weight.list"); + my ($sfh, $streaks_list) = open_list_file($outroot, "streaks.list"); + + # do this in eval so we can fault the exposure without + # passing the $magic_id and $node everywhere + eval { + foreach my $innode (@$inputs) { + # root for inputs from previous stage + my $in_path_base = $innode->{magic_path_base}; + print $sfh "$in_path_base\n"; + + cat_list_to_list($in_fh, $in_path_base, "input.list"); + # build input lists by combining the lists from + # previous stages + cat_list_to_list($ifh, $in_path_base, "image.list"); + cat_list_to_list($mfh, $in_path_base, "mask.list"); + cat_list_to_list($wfh, $in_path_base, "weight.list"); + + if ($innode->{inverse}) { + $inverse = 1; + } + } + close $in_fh; + close $ifh; + close $mfh; + close $wfh; + close $sfh; + + $command .= " --merge --inputs $input_list"; + $command .= " --images $image_list --masks $mask_list --weights $weight_list" ; + $command .= " --inputstreaks $streaks_list"; + # new option to "merge duplicate streaks into unique streaks" + $command .= " --duplicates"; + }; + if ($@) { + &my_die("failed to create file lists: $@", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + } + } + + unless ($no_op) { + # DetectStreaks fails if an output file already exists + foreach my $output (@outputs) { + unlink($output) if -e $output; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform DetectStreaks: $error_code", $magic_id, $node, $error_code); + } + + foreach my $output (@outputs) { + file_check( $output ); + } + + foreach my $file (@deletions) { + print "Deleting $file...\n"; + $ipprc->file_delete($file); + } + + } else { + print "Skipping command: $command\n"; + } + +} + + +if ($node eq "root") { + # XXXX: Since we just added the result above, all of these my_dies are going to fail + # with a duplicate row error. + # see more comments below + my $streaks_file = "$outroot.streaks"; + my $resolved = $ipprc->file_resolve($streaks_file); + + my $num_streaks = -1; + unless ($no_op) { + my $fh; + open $fh, "<$resolved" or + &my_die("failed to open streaks file $streaks_file", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + # the first line in the streaks file contains the number of streaks found + $num_streaks = <$fh>; + chomp $num_streaks; + close $fh; + print "$num_streaks streaks found on magicRun $magic_id\n" if $verbose; + } + + + my $exp_id; # Exposure identifier + my $cam_path; # Camera stage path_base + { + my $command = "magictool -exposure -magic_id $magic_id"; + $command .= " -inverse" if defined $inverse; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + my $exposures = $mdcParser->parse_list(join "", @$stdout_buf); + my $exp = $$exposures[0]; # Exposure of interest (should only be one) + if (!$exp) { + &my_die("magictool -exposure returned no output", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + } + + $exp_id = $exp->{exp_id}; + $cam_path = $exp->{path_base}; + } + + &run_verifystreaks($baseroot, $exp_id); + + { + my $astrom = $ipprc->filename("PSASTRO.OUTPUT", $cam_path); # Astrometry file + my $streaks = "$outroot.streaks"; # Streaks file + my $clusters = "$baseroot.verify/${exp_id}_clusterPos.txt"; # Clusters file + + my $command = "ppCoord -astrom $astrom -streaks $streaks"; + if ($ipprc->file_exists($clusters)) { + $command .= " -clusters $clusters"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + open my $coords, "> $outroot.coords"; + print $coords join("", @$stdout_buf); + close $coords; + } + + my $output_streaks = $final_outroot . ".streaks"; + if ($output_streaks and ($output_streaks ne $streaks_file)) { + copy_to_nebulous($ipprc, $streaks_file, $output_streaks, 1); + my $streaks_map = $outroot . ".streakMap"; + my $output_streaks_map = $final_outroot . ".streakMap"; + copy_to_nebulous($ipprc, $streaks_map, $output_streaks_map, 1); + foreach my $f (keys %verify_outputs) { + my $replicate = $verify_outputs{$f}; + my $src = "$baseroot.verify/${exp_id}_$f"; + my $dest = "$final_outroot.${f}"; + copy_to_nebulous($ipprc, $src, $dest, $replicate); + } + } else { + $output_streaks = $streaks_file; + } + + { + my $command = "$magictool -addmask"; + $command .= " -magic_id $magic_id"; + $command .= " -path_base $final_outroot"; + $command .= " -streaks $num_streaks"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magictool -addmask: $error_code", $magic_id, $node, $error_code); + } + } else { + print "Skipping command: $command\n"; + } + } +} + + ### Input result into database +{ + my $command = "$magictool -addresult"; + $command .= " -magic_id $magic_id"; + $command .= " -node $node"; + $command .= " -path_base $outroot"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + # XXX: if this is the root node we need to revert delete the magicMask object + # inserted above + &my_die("Unable to perform magictool -addresult: $error_code", $magic_id, $node, $error_code); + } + } else { + print "Skipping command: $command\n"; + } +} + + +### Pau. + +sub run_verifystreaks { + + my $baseroot = shift; + my $exp_id = shift; + + unless ($VerifyStreaks) { + print STDERR "skipping VerifyStreaks\n"; + return 1; + } + + # VerifyStreaks --out $outdir --clusters $outdir/clusters.list $rootname.root.streakMap + + my $outdir = "$baseroot.verify"; + + my($status) = system ("mkdir -p $outdir"); + if ($status) { + print STDERR "failed to create output directory $outdir\n"; + return 1; + } + + my $FILE; + + my @files = <$baseroot.*.clusters>; + + my $clusters_list = "$outdir/${exp_id}_clusters.list"; + unless (open ($FILE, ">$clusters_list")) { + print "failed to create cluster file $clusters_list\n"; + return 1; + } + foreach my $file (@files) { + $file =~ s|.clusters$||; + print $FILE "$file\n"; + } + close ($FILE); + if ($status) { + print "failed to create cluster file $clusters_list\n"; + return 1; + } + + my $command = "$VerifyStreaks --out $outdir --clusters $clusters_list $baseroot.root.streakMap"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + print "failed to run VerifyStreaks:\n"; + return 1; + } + + return 0; +} + +sub open_list_file { + my $outroot = shift; + my $extension = shift; + + my $filename = "$outroot.$extension"; + + my $fh; + open $fh, ">$filename" or die "failed to open list file $filename"; + + return ($fh, $filename); +} + +sub cat_list_to_list { + my $out = shift; # output file handle + my $path_base = shift; # path_base to append ... + my $extension = shift; # ... the extension to + + my $filename = "$path_base.$extension"; + + my $in; + open $in, "<$filename" or die "failed to open list file: $filename"; + foreach my $line (<$in>) { + print $out $line; + } +} + +sub resolve_inputs +{ + my $node = shift; + my $input_base = $node->{diff_path_base}; + + my ($image, $mask, $variance); # Names to return + if ($node->{inverse}) { + $image = "PPSUB.INVERSE"; + $mask = "PPSUB.INVERSE.MASK"; + $variance = "PPSUB.INVERSE.VARIANCE"; + } else { + $image = "PPSUB.OUTPUT"; + $mask = "PPSUB.OUTPUT.MASK"; + $variance = "PPSUB.OUTPUT.VARIANCE"; + } + + $image = $ipprc->file_resolve($ipprc->filename($image, $input_base)); + $mask = $ipprc->file_resolve($ipprc->filename($mask, $input_base)); + $variance= $ipprc->file_resolve($ipprc->filename($variance, $input_base)); + + return ($image, $mask, $variance); +} + +sub file_check +{ + my $file = shift; # Name of file + &my_die("Unable to find output file: $file", $magic_id, $node, $PS_EXIT_SYS_ERROR) unless + $ipprc->file_exists($file); +} + +# Copy a file to nebulous and optionally replicate it +# We should consider making this an ipprc function. For now try it here so we can print +# the right error messages +sub copy_to_nebulous { + my $ipprc = shift; + my $src = shift; + my $dest = shift; + my $replicate = shift; + + print "copying $src to $dest\n"; + + $ipprc->file_exists($src) or + &my_die("expected output file does not exist: $src", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + + # copy the file to it's final destination - which is presumably in nebulous + # we delete it so that all instances are deleted in case it has been replicated + if ($ipprc->file_exists($dest)) { + $ipprc->file_delete($dest) or + &my_die("failed to delete existing file: $dest", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + } + my $dest_resolved = $ipprc->file_resolve($dest, 'create'); + &my_die("failed to resolve $dest", $PS_EXIT_UNKNOWN_ERROR) if !$dest_resolved; + + copy ($src, $dest_resolved) or + &my_die("failed to copy $src to $dest", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + + if ($replicate and (file_scheme($dest) eq 'neb')) { + my $neb = $ipprc->nebulous(); + $neb->setxattr($dest, 'user.copies', 2, 'create') or + &my_die("failed to set user.copies for $dest", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + + $neb->replicate($dest) or + &my_die("failed to replicate $dest", $magic_id, $node, $PS_EXIT_UNKNOWN_ERROR); + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $magic_id = shift; # Magic identifier + my $node = shift; # Node name + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $magic_id and defined $node and not $no_update) { + my $command = "$magictool -addresult"; + $command .= " -magic_id $magic_id"; + $command .= " -node $node"; + $command .= " -fault $exit_code"; + $command .= " -path_base $outroot" if defined $outroot; + $command .= " -dbname $dbname" if defined $dbname; + system($command); + } + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_tree.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_tree.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/magic_tree.pl (revision 41105) @@ -0,0 +1,381 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use Astro::FITS::CFITSIO qw( :constants ); +Astro::FITS::CFITSIO::PerlyUnpacking(1); + +use Math::Trig; +use File::Temp qw( tempfile ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +use constant MAX_FIELDS => 4; # Maximum number of fields to be in a node + +# Look for programs we need +my $missing_tools; +my $magictool = can_run('magictool') or (warn "Can't find magictool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($magic_id, $warp_id, $tess_id, $camera, $ra0, $dec0, $dbname, $outroot, + $save_temps, $verbose, $no_update, $no_op, $logfile); +GetOptions( + 'magic_id=s' => \$magic_id, # Magic identifier + 'warp_id=s' => \$warp_id, # id for corresponding warps + 'tess_id=s' => \$tess_id, # Tessellation identifier + 'camera=s' => \$camera, # Camera name + 'ra=f' => \$ra0, # Boresight right ascension, radians + 'dec=f' => \$dec0, # Boresight declination, radians + 'dbname=s' => \$dbname, # Database name + 'outroot=s' => \$outroot, # Output root name + 'save-temps' => \$save_temps, # Save temporary files? + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, # Redirect output? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --magic_id --camera --tess_id --ra --dec --outroot", + -exitval => 3) unless + defined $magic_id and + defined $tess_id and + defined $ra0 and + defined $dec0 and + defined $camera and + defined $outroot; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $magic_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $magic_id, $PS_EXIT_SYS_ERROR ) if $logfile; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +### Get a list of skycells +my @skycells; # List of skycells +{ + my $command = "$magictool -inputskyfile -magic_id $magic_id"; # Command to run + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magictool -inputskyfile: $error_code", $magic_id, $error_code); + } + + my $magictool_output = join "", @$stdout_buf; + # if there is no output from magictool that means that there are no + # diffSkyfiles with non-zero quality. Set fault to a special value so + # that these magicRuns can be recognized and dropped. + &my_die("magictool -inputskyfile returned no output. Inputs are probably all bad quality.", $magic_id, 42) + if !$magictool_output; + my $metadata = $mdcParser->parse($magictool_output) or + &my_die("Unable to parse metadata config doc", $magic_id, $PS_EXIT_PROG_ERROR); + + my $inputs = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $magic_id, $PS_EXIT_PROG_ERROR); + + foreach my $input ( @$inputs ) { + push @skycells, $input; # NB: Storing the skycell_id in magicInputSkyfile.node + } +} + +### For each skycell, project centre of skycell onto tangent plane of boresight +my @fields; +foreach my $input ( @skycells ) { + # We use the WCS in the diff image + my $name = "PPSUB.OUTPUT"; # Name of file + my $skycell_id = $input->{node}; # Name of skycell + my $skyfile = $ipprc->filename($name, $input->{path_base}, $skycell_id); # Filename for diff + my $skyfileResolved = $ipprc->file_resolve( $skyfile ); # Resolved filename + + my ($header, $status) = (undef, 0); + my $fits = Astro::FITS::CFITSIO::open_file( $skyfileResolved, READONLY, $status ); + &my_die("failed to open skycell file: $skyfileResolved: $status", $magic_id, $PS_EXIT_SYS_ERROR) if $status; + + ($header, $status) = Astro::FITS::CFITSIO::fits_read_header( $fits ); + + &my_die("Unable to read skycell header: $status", $magic_id, $PS_EXIT_SYS_ERROR) if $status; + + + # Get the useful header keywords + my $naxis1 = $$header{'NAXIS1'}; + my $naxis2; + if ($naxis1) { + $naxis2 = $$header{'NAXIS2'} or &my_die("Can't find NAXIS2", $magic_id, $PS_EXIT_SYS_ERROR); + } else { + # if the skyfile is compressed then the WCS won't be in the primary header, move to the + # extension + my $hdutype; + $fits->movrel_hdu(1, $hdutype, $status); + &my_die("Unable to movrel_hdu: $status", $magic_id, $PS_EXIT_SYS_ERROR) if $status; + + ($header, $status) = Astro::FITS::CFITSIO::fits_read_header( $fits ); + &my_die("Unable to read extension header: $status", $magic_id, $PS_EXIT_SYS_ERROR) if $status; + my $xtension = $$header{'XTENSION'} or &my_die("Can't find XTENSION", $magic_id, $PS_EXIT_SYS_ERROR); + &my_die("XTENSION found: $xtension", $magic_id, $PS_EXIT_SYS_ERROR) if $xtension ne "'BINTABLE'"; + $naxis1 = $$header{'ZNAXIS1'} or &my_die("Can't find ZNAXIS1", $magic_id, $PS_EXIT_SYS_ERROR); + $naxis2 = $$header{'ZNAXIS2'} or &my_die("Can't find ZNAXIS2", $magic_id, $PS_EXIT_SYS_ERROR); + } + my $ctype1 = $$header{'CTYPE1'} or &my_die("Can't find CTYPE1 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $ctype2 = $$header{'CTYPE2'} or &my_die("Can't find CTYPE2 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $cdelt1 = $$header{'CDELT1'} or &my_die("Can't find CDELT1 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $cdelt2 = $$header{'CDELT2'} or &my_die("Can't find CDELT2 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $crval1 = $$header{'CRVAL1'} or &my_die("Can't find CRVAL1 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $crval2 = $$header{'CRVAL2'} or &my_die("Can't find CRVAL2 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $crpix1 = $$header{'CRPIX1'} or &my_die("Can't find CRPIX1 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $crpix2 = $$header{'CRPIX2'} or &my_die("Can't find CRPIX2 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $pc11 = $$header{'PC001001'} or &my_die("Can't find PC001001 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $pc12 = $$header{'PC001002'} or &my_die("Can't find PC001002 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $pc21 = $$header{'PC002001'} or &my_die("Can't find PC002001 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $pc22 = $$header{'PC002002'} or &my_die("Can't find PC002002 in $skyfile", $magic_id, $PS_EXIT_SYS_ERROR); + my $crota1 = $$header{'CROTA1'}; + my $crota2 = $$header{'CROTA2'}; + + &my_die("Unexpected projection: $ctype1 and $ctype2.", $magic_id, $PS_EXIT_SYS_ERROR) unless + $ctype1 =~ /^\'RA---TAN\s*\'$/ and $ctype2 =~ /^\'DEC--TAN\s*\'$/; + &my_die("Can't determine size of skycell ($naxis1,$naxis2)", $magic_id, $PS_EXIT_SYS_ERROR) unless + $naxis1 > 0 and $naxis2 > 0; + &my_die("Can't determine scale of skycell ($cdelt1,$cdelt2)", $magic_id, $PS_EXIT_SYS_ERROR) if + not defined $cdelt1 or $cdelt1 == 0 or not defined $cdelt2 or $cdelt2 == 0; + &my_die("We don't know how to handle rotations ($crota1,$crota2)", $magic_id, $PS_EXIT_SYS_ERROR) + if defined $crota1 or defined $crota2; + + # Relative coordinates of centre of the field + my $x = $naxis1/2 - $crpix1; + my $y = $naxis2/2 - $crpix2; + + # Coordinates on tangent plane + my $xi = $pc11 * ($x) + $pc12 * ($y); + my $eta = $pc21 * ($x) + $pc22 * ($y); + $xi *= $cdelt1; + $eta *= $cdelt2; + + # Coordinates on rotated celestial sphere + my ($phi, $theta); + if ($xi == 0 and $eta == 0) { + $phi = 0; + $theta = 0; + } else { + $phi = atan2($eta,$xi) + pi/2; + my $denominator = sqrt($xi**2 + $eta**2); + &my_die("denominator is zero!!", $magic_id, $PS_EXIT_PROG_ERROR) if $denominator == 0; + $theta = atan(180 / pi / $denominator); + } + + # Coordinates on celestial sphere + $crval1 = deg2rad($crval1); + $crval2 = deg2rad($crval2); + my $ra = $crval1 + atan2(cos($theta) * sin($phi), + sin($theta) * cos($crval2) + cos($theta) * sin($crval2) * cos($phi)); + my $dec = asin(sin($theta) * sin($crval2) - cos($theta) * cos($crval2) * cos($phi)); + + # Rotate to boresight + my $phi_new = atan2(cos($dec) * sin($ra - $ra0), + sin($dec) * cos($dec0) + cos($dec) * sin($dec0) * cos($ra - $ra0)); + my $theta_new = asin(sin($dec) * sin($dec0) - cos($dec) * cos($dec0) * cos($ra - $ra0)); + + # Project + my $rad = 180 / pi * cot($theta_new); + my $xi_new = $rad * sin($phi); + my $eta_new = - $rad * cos($phi); + + my $field = { id => $skycell_id, + xi => $xi_new, + eta => $eta_new, + }; + + push @fields, $field; +} + +### Subdivide list of positions into kd-tree +my $root = { # Root node of tree + contents => \@fields, # Contents of node + position => 'root', # Position in tree + children => {}, # Children of node +}; +my @tasks = ( $root ); +while (scalar @tasks) { + my $node = shift @tasks; + divide_node($node, \@tasks); +} + +### Format tree for magictool +my $mdcTree = print_node($root); # The tree in MDC format +my ($treeFile, $treeName) = tempfile( "magictree.${magic_id}.XXXX", UNLINK => !$save_temps ); +print $treeFile $mdcTree; +close $treeFile; + +### Input tree into database +if (!$no_update) { + my $command = "$magictool -inputtree"; + $command .= " -magic_id $magic_id"; + $command .= " -dep_file $treeName"; + $command .= " -dbname $dbname" if defined $dbname; + + # Add the processed file to the database + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform magictool -inputtree: $error_code", $magic_id, $error_code); + } + } else { + print "Skipping command: $command\n"; + } +} + +### Pau. + +sub my_die +{ + my $msg = shift; # Warning message on die + my $magic_id = shift; # Magic identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $magic_id and not $no_update) { + my $command = "$magictool -inputtree"; + $command .= " -magic_id $magic_id"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system($command); + } + exit $exit_code; +} + +# Divide a list into two, returning the lower and upper parts +sub divide_list +{ + my $list = shift; # List to divide + my $index = shift; # Name of index for sorting + + my @sorted = sort { $$a{$index} <=> $$b{$index} } @$list; # Sorted list + my $median = int(scalar @sorted / 2); # Median point of list + my @upper = splice(@sorted, $median); # Upper part of the sorted list + +# print " median $median\n"; + + return (\@sorted, \@upper); +} + +# Create a new node, add it to the parent, and add it to the task list if required +sub new_node +{ + my $parent = shift; # The parent node + my $contents = shift; # Contents of the new node + my $position = shift; # Position description + my $tasks = shift; # Tasks to do + + my $node = { + contents => $contents, + position => $parent->{position} . '_' . $position, + children => {}, + }; + +# my $n = scalar @$contents; +# print "new node: $node->{position}: $n\n"; + + $parent->{children}->{$position} = $node; + + push @$tasks, $node if scalar @$contents > 4; + + return $node; +} + +# Divide a node +sub divide_node +{ + my $node = shift; # Node to divide + my $tasks = shift; # Tasks to do + + my $position = $node->{position}; + + my $contents = $node->{contents} or die "Can't find contents of node."; # Contents of node + + if ($position eq 'root' and scalar @$contents <= 4) { + # don't need to divide, but do we need to sort? + return; + } + + my ($lower, $upper) = divide_list($contents, 'xi'); + + if (scalar @$lower > 4) { + my ($ll, $lr) = divide_list($lower, 'eta'); + new_node($node, $ll, 'll', $tasks); + new_node($node, $lr, 'lr', $tasks); + } else { + new_node($node, $lower, 'L', $tasks); + } + + if (scalar @$upper > 4) { + my ($ul, $ur) = divide_list($upper, 'eta'); + new_node($node, $ul, 'ul', $tasks); + new_node($node, $ur, 'ur', $tasks); + } else { + new_node($node, $upper, 'U', $tasks); + } + + $node->{contents} = undef; + + return $node; +} + +# Print the contents of a node +sub print_node +{ + my $node = shift; # Node to print + + my $position = $node->{position}; # Position of node + + my $output = "$position\t\tMULTI\n"; # Output text + + if (defined $node->{contents}) { + foreach my $field ( @{$node->{contents}} ) { + my $skycell_id = $field->{id}; # Skycell name + $output .= "$position\t\tSTR\t$skycell_id\n"; + $output .= "$skycell_id\t\tSTR\tNULL\t\# $field->{xi},$field->{eta}\n"; + } + } else { + foreach my $div ( keys %{$node->{children}} ) { + $output .= "$position\t\tSTR\t${position}_$div\n"; + $output .= print_node($node->{children}->{$div}); + } + } + + return $output; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/make_burntool_pcontrol.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/make_burntool_pcontrol.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/make_burntool_pcontrol.pl (revision 41105) @@ -0,0 +1,526 @@ +#!/usr/bin/env perl +# script to generate a pcontrol.pro file to run burntool on a set of data. + +use DBI; +use warnings; +use DateTime; +use Getopt::Std; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use IPC::Cmd 0.36 qw( can_run run); + +use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock'; + +getopts('hbPQ:d:',\%opt); +if (exists($opt{h})) { + print STDERR "Usage: make_burntool_pcontrol.pl -b {-Q | -d | DATE_MIN0 DATE_MAX0 DATE_MIN1 DATE_MAX1 [...]}\n"; + print STDERR " -Q SQL_WHERE Generate pcontrol from a SQL WHERE query.\n"; + print STDERR " (enclose in single quotes, and use double quotes inside to\n"; + print STDERR " protect from the shell)\n"; + print STDERR " -d DATE Specify a single day to look for.\n"; + print STDERR " -b Only print burntool lines.\n"; + print STDERR " -P PR images have bad obs_mode values. Work around that.\n"; + print STDERR "\n"; + print STDERR " Scans the GPC1 database, and identifies \"science\" observations based on the obs_mode.\n"; + print STDERR " Use a 30 minute safety prelude before the first science data to make sure burntool works.\n"; + + exit(1); +} + +# Load database +## change to use the site.config setting now +$dbname = 'gpc1'; +#$dbserver = 'ippdb01'; +$dbuser = 'ipp'; +$dbpass = 'ipp'; +my $ipprc = PS::IPP::Config->new(); # IPP Configuration +my $siteConfig = $ipprc->{_siteConfig}; +my $dbserver = metadataLookupStr($siteConfig, 'DBSERVER'); +die "database configuration not set up" unless defined($dbserver); +$db = DBI->connect("DBI:mysql:database=${dbname};host=${dbserver};" . + "mysql_socket=" . DB_SOCKET(), + ${dbuser},${dbpass}, + { RaiseError => 1, AutoCommit => 1} + ) or die "Unable to connect to database $DBI::errstr\n"; + +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + die "Cannot find required tools."; +} +# Determine what the value of "BURNTOOL.STATE.GOOD" currently is: +$burntoolStateGood = 999; +open(LAZY,"$ppConfigDump -camera GPC1 -dump-camera - |") || die "Can't run ppConfigDump\n"; +while() { + chomp; + if ($_ =~ /BURNTOOL.STATE.GOOD\s/) { + @line = split /\s+/; + $burntoolStateGood = $line[2]; + } +} +close(LAZY); + +# Read the nightly science config file and use that to determine which data is science +my $verbose = 0; +my $conf_cmd = "$ppConfigDump -dump-recipe NIGHTLY_SCIENCE -"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDUmp: $error_code", $date, $PS_EXIT_SYS_ERROR); +} + +my @target_list; +my %object_list; +my $comment_list; + +my $mdcParser = PS::IPP::Metadata::Config->new; +my $metadata = $mdcParser->parse(join "", @$stdout_buf); +foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'TARGETS') { + my @target_data = @{ ${ $entry }{value} }; + my $this_target = ''; + + foreach my $tentry (@target_data) { + if (${ $tentry }{name} eq 'NAME') { + $this_target = ${ $tentry }{value}; + push @target_list, $this_target; + $obsmode_list{$this_target} = '.*'; + $object_list{$this_target} = '.*'; + $comment_list{$this_target} = '.*'; + } + elsif (${ $tentry }{name} eq 'OBSMODE') { + $obsmode_list{$this_target} = ${ $tentry }{value}; + $obsmode_list{$this_target} =~ s/%//; + } + elsif (${ $tentry }{name} eq 'OBJECT') { + $object_list{$this_target} = ${ $tentry }{value}; + $object_list{$this_target} =~ s/%//; + } + elsif (${ $tentry }{name} eq 'COMMENT') { + $comment_list{$this_target} = ${ $tentry }{value}; + $comment_list{$this_target} =~ s/%//; + } + } + } +} +if (exists($opt{P})) { + push @target_list, 'PR'; + $obsmode_list{'PR'} = 'Unknown'; + $object_list{'PR'} = '.*'; + $comment_list{'PR'} = '.*'; +} + +# Zero the arrays and counters +@dates_min = (); +@dates_max = (); +$N_burntooled_images = 0; +$N_total_images = 0; +$N_ranges = 0; +# Parse SQL query and fill any valid dates to the arrays +if (exists($opt{Q})) { + $opt{Q} =~ s/\"/\'/g; + $sth = "SELECT dateobs FROM rawExp WHERE $opt{Q}"; + $data_ref = $db->selectall_arrayref( $sth ); + + %day_keys = (); + foreach $row_ref (@{ $data_ref }) { + ($day,$time) = split /\s+/, ${ $row_ref }[0]; + + unless (exists($day_keys{$day})) { + push @dates_min, $day; + + ($year,$mon,$date) = split /-/, $day; + $date++; + push @dates_max, sprintf("%04d-%02d-%02d",$year,$mon,$date); + $day_keys{$day} = 1; +# print ">>>D $day $#dates_min\n"; + } + } +} + +# Read a single date, and calculate the end and insert +elsif (exists($opt{d})) { + push @dates_min, $opt{d}; + ($year,$mon,$date) = split /-/, $opt{d}; + $date++; + push @dates_max, sprintf("%04d-%02d-%02d",$year,$mon,$date); +} + +# Just shift the supplied values into the arrays. +else { + if ($#ARGV == -1) { + system("$0 -h"); + exit(-1); + } + + while ($#ARGV > -1) { + push @dates_min, shift(@ARGV); + push @dates_max, shift(@ARGV); + } +} +unless(exists($opt{b})) { + print_prologue(); +} +# Save the query used in the pcontrol to be safe. +if (exists($opt{Q})) { + print "##query: SELECT dateobs FROM rawExp WHERE $opt{Q}\n"; +} + +while ($#dates_min > -1) { + $date_min = shift(@dates_min); + $date_max = shift(@dates_max); + + # Find _ALL_ observations within the date range we care about + $sth = "SELECT exp_id,dateobs,pon_time,exp_type,obs_mode,comment,object FROM rawExp WHERE " . + "dateobs >= '${date_min}' AND dateobs <= '${date_max}' order by dateobs"; + + $data_ref = $db->selectall_arrayref( $sth ); + + $seq = 0; + + # Identify the science observations, and make a window earlier for burntool. + @start_s = (0); + @end_s = (0); + @skips = (0); + + foreach $row_ref (@{ $data_ref }) { + + ($exp_id,$dateobs,$pontime,$exp_type,$obs_mode,$comment,$object) = @{ $row_ref }; + # Fix nulls in the database + if (!defined($obs_mode)) { + $obs_mode = ' '; + } + if (!defined($object)) { + $object = ' '; + } + if (!defined($comment)) { + $comment = ' '; + } + + ($date,$time) = split / /, $dateobs; + ($year,$month,$day) = split /-/, $date; + ($hour,$minute,$second) = split /:/, $time; # / # This stops emacs run-on syntax highlights. + + $dt = DateTime->new( year => $year, month => $month, day => $day, + hour => $hour, minute => $minute, second => $second, + nanosecond => 0, time_zone => 'Pacific/Honolulu'); + + $st = DateTime->new( year => $year, month => $month, day => $day, + hour => $hour, minute => $minute, second => $second, + nanosecond => 0, time_zone => 'Pacific/Honolulu')->subtract(minutes => 30); + $et = $dt->epoch(); + + if (is_science($exp_type,$obs_mode,$object,$comment)) { + if ($start_s[-1] == 0) { + $start_s[-1] = $et - 1800; + $end_s[-1] = $et + 1; + } + else { + if ($et > $end_s[-1] + 1800) { + push @start_s, $et - 1800; + push @end_s, $et + 1; + push @skips, 0; + } + else { + $end_s[-1] = $et + 1; + } + } + } + + $seq++; + + } + + # If this night has no science exposures, skip to the next one. + if (($#start_s == 0) && ($start_s[0] == 0)) { + next; + } + + # Scan again and count how many exposures are between windows + foreach $row_ref (@{ $data_ref }) { + ($exp_id,$dateobs,$pontime,$exp_type,$obs_mode,$comment,$object) = @{ $row_ref }; + if (!defined($obs_mode)) { + $obs_mode = ' '; + } + if (!defined($comment)) { + $comment = ' '; + } + + ($date,$time) = split / /, $dateobs; + ($year,$month,$day) = split /-/, $date; + ($hour,$minute,$second) = split /:/, $time; # / # another emacs syntax highlight bug. + + $dt = DateTime->new( year => $year, month => $month, day => $day, + hour => $hour, minute => $minute, second => $second, + nanosecond => 0, time_zone => 'Pacific/Honolulu'); + + $st = DateTime->new( year => $year, month => $month, day => $day, + hour => $hour, minute => $minute, second => $second, + nanosecond => 0, time_zone => 'Pacific/Honolulu')->subtract(minutes => 30); + $et = $dt->epoch(); + + for ($i = 0; $i <= $#start_s; $i++) { + if (($et < $start_s[$i])&&(is_science($exp_type,$obs_mode,$object,$comment) == 0)) { + if ($i == 0) { + $skips[$i]++; + } + else { + if ($et > $end_s[$i-1]) { + $skips[$i]++; + } + } + } + } + } + + # Clear out windows that overlap with previous ones so we have the minimum set + for ($i = $#start_s; $i > 0; $i--) { + if ($skips[$i] == 0) { + $trash = pop(@start_s); + $end = pop(@end_s); + $trash = pop(@skips); + $end_s[-1] = $end; + } + } + # Print out the end points in the format burntool wants. + + for ($i = 0; $i <= $#start_s; $i++) { + @start_t = localtime($start_s[$i]); + @end_t = localtime($end_s[$i]); + + my $date_min = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", + $start_t[5] + 1900,$start_t[4] + 1,$start_t[3], + $start_t[2],$start_t[1],$start_t[0]); + my $date_max = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", + $end_t[5] + 1900,$end_t[4] + 1,$end_t[3], + $end_t[2],$end_t[1],$end_t[0]); + + my $total_images_sth = "SELECT count(exp_id) from rawImfile where dateobs >= '$date_min' AND dateobs <= '$date_max'"; + my $im_ref = $db->selectall_arrayref( $total_images_sth ); + $N_total_images += ${ $im_ref }[0][0]; + + my $burntooled_images_sth = "SELECT count(exp_id) from rawImfile where dateobs >= '$date_min' AND dateobs <= '$date_max' AND abs(burntool_state) = $burntoolStateGood"; + $im_ref = $db->selectall_arrayref( $burntooled_images_sth ); + $N_burntooled_images += ${ $im_ref }[0][0]; + + + printf(" burntool %s %s\n",$date_min,$date_max); + } + unless(exists($opt{d})) { + print "\n"; + } + $N_ranges += ($#start_s + 1); +} + +if ($N_ranges == 0) { + print_short_epilogue(); +} + +unless(exists($opt{b}) || ($N_ranges == 0)) { + print_epilogue(); +} + + +# Subroutine to use the configuration file data and the exposure data to determine whether or not something is "science" +sub is_science { +# if (is_science($exp_type,$obs_mode,$object,$comment)) { + my ($exp_type,$obs_mode,$object,$comment) = @_; + my $return_value = 0; + unless($object) { + $object = ''; + } + if ($exp_type eq 'OBJECT') { + foreach my $target (@target_list) { +# print STDERR "$target $obsmode_list{$target} $exp_type $obs_mode $object $comment\n"; + if (($obs_mode =~ /$obsmode_list{$target}/i)&& + ($object =~ /$object_list{$target}/i)&& + ($comment =~ /$comment_list{$target}/i)) { + $return_value = 1; + } +# print ">$return_value $exp_type $obs_mode $object $comment <> $target $obsmode_list{$target} $object_list{$target} $comment_list{$target}\n"; + if ($return_value) { + return($return_value); + } + } + } + return(0); +} + +## +## These functions print out the remaining text of the pcontrol.pro script. I've removed things +## that seemed superfluous. +## + +sub print_prologue { + + print << 'END_PROLOGUE'; +# this script sets up a series of burntool runs targetted to the appropriate machine + +# use the following sql to get the host table match: +# select exp_id, exp_name, class_id, dateobs, user_1, obs_mode, uri from rawImfile where exp_id = 33750 limit 100; + +macro burntool + if ($0 != 3) + echo "USAGE: burntool (dateobs_begin) (dateobs_end)" + break + end + + for i 0 $hostmatch:n + list word -split $hostmatch:$i + $class_id = $word:0 + $logfile = "burntool_logs/$class_id.$1.log" + job -host $word:1 ipp_apply_burntool.pl --class_id $class_id --dateobs_begin $1 --dateobs_end $2 --dbname gpc1 --logfile $logfile + end +end + +macro go +END_PROLOGUE + +return(0); +} +sub print_short_epilogue { + if (exists($opt{b})) { + print STDERR "There were no science exposures to process. Sorry, try again tomorrow.\n"; + return(); + } + print << 'END_SHORT_EPILOGUE'; + + echo "There were no science exposures to process. Sorry, try again tomorrow." + +end +END_SHORT_EPILOGUE +} + +sub print_epilogue { + print " echo 'There were $N_total_images total images, of which $N_burntooled_images were already burntooled.'\n"; + print "### BTSTAT $N_total_images $N_burntooled_images\n"; + print << 'END_EPILOGUE'; + +end + +macro setnames + $burntool_range:20081001 = 2008-10-01T07:50:00 2008-10-01T15:05:00 +end + +# for a re-run add --skip_burned: +# job -host $word:1 ipp_apply_burntool.pl --class_id $word:0 --dateobs_begin $1 --dateobs_end $2 --dbname gpc1 --skip_burned + +macro loadhosts + for i 0 $allhosts:n + host add $allhosts:$i + end +end + +# this macro may be used to complete a burntool run that exited due to error +macro burntool_skip_burned + if ($0 != 3) + echo "USAGE: burntool (dateobs_begin) (dateobs_end)" + break + end + + for i 0 $hostmatch:n + list word -split $hostmatch:$i + $class_id = $word:0 + $logfile = "burntool_logs/$class_id.$1.log" + job -host $word:1 ipp_apply_burntool.pl --class_id $class_id --dateobs_begin $1 --dateobs_end $2 --dbname gpc1 --skip_burned --logfile $logfile + end +end + +list hostmatch + XY01 ipp014 + XY02 ipp014 + XY03 ipp038 + XY04 ipp038 + XY05 ipp023 + XY06 ipp023 + XY10 ipp039 + XY11 ipp039 + XY12 ipp024 + XY13 ipp024 + XY14 ipp040 + XY15 ipp040 + XY16 ipp026 + XY17 ipp026 + XY20 ipp041 + XY21 ipp041 + XY22 ipp042 + XY23 ipp042 + XY24 ipp043 + XY25 ipp043 + XY26 ipp028 + XY27 ipp028 + XY30 ipp044 + XY31 ipp044 + XY32 ipp029 + XY33 ipp029 + XY34 ipp045 + XY35 ipp045 + XY36 ipp030 + XY37 ipp030 + XY40 ipp046 + XY41 ipp046 + XY42 ipp031 + XY43 ipp031 + XY44 ipp047 + XY45 ipp047 + XY46 ipp032 + XY47 ipp032 + XY50 ipp048 + XY51 ipp048 + XY52 ipp033 + XY53 ipp033 + XY54 ipp049 + XY55 ipp049 + XY56 ipp034 + XY57 ipp034 + XY60 ipp050 + XY61 ipp050 + XY62 ipp035 + XY63 ipp035 + XY64 ipp051 + XY65 ipp051 + XY66 ipp036 + XY67 ipp036 + XY71 ipp052 + XY72 ipp052 + XY73 ipp015 + XY74 ipp015 + XY75 ipp053 + XY76 ipp053 +end +list allhosts + ipp043 + ipp014 + ipp015 + ipp023 + ipp024 + ipp026 + ipp028 + ipp029 + ipp030 + ipp031 + ipp032 + ipp033 + ipp034 + ipp035 + ipp036 + ipp038 + ipp039 + ipp040 + ipp041 + ipp042 + ipp044 + ipp045 + ipp046 + ipp047 + ipp048 + ipp049 + ipp050 + ipp051 + ipp052 + ipp053 +end + +END_EPILOGUE +return(0); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mdc2list.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mdc2list.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mdc2list.pl (revision 41105) @@ -0,0 +1,77 @@ +#!/usr/bin/env perl + +# Program to convert a PS metadata config syntax (usually from one of +# the IPP tools) into a flat tab-delimited list suitable for parsing +# using "split". + +# Copyright (C) 2006 Joshua Hoblitt, Paul A. Price. + +use strict; +use warnings; + +use PS::IPP::Metadata::Config; # Supplies the metadata config parser. + +die "Program to convert a PS metadata config file (usually from one of the IPP\n" . + "tools) into a flat tab-delimited list suitable for parsing using \'split\'.\n\n" . + "Usage: $0 [INFILE [OUTFILE]]\n" if ((join "", @ARGV) =~ /--help/ or scalar @ARGV > 2); + +my $inFile; # Input file +my $outFile; # Output file +if (scalar @ARGV >= 1) { + my $inName = shift @ARGV; + open $inFile, $inName or die "Can't open $inName: $!\n"; + if (scalar @ARGV == 1) { + my $outName = shift @ARGV; + open $outFile, ">", $outName or die "Can't open $outName: $!\n"; + } else { + $outFile = *STDOUT; + } +} else { + $inFile = *STDIN; + $outFile = *STDOUT; +} + +my @input = <$inFile>; # Contents of the metadata config file +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $md = $mdcParser->parse(join "", @input) + or die "unable to parse metadata config doc"; +my $hashes = mds2hashes($md); # An array of hashes +foreach my $pending (@$hashes) { + foreach my $key (keys %$pending) { + print $outFile ( $pending->{$key} . "\t"); + } + print $outFile "\n"; +} + +### Pau. + + +# Given an array of MDs, return an array of hashes +sub mds2hashes +{ + my $mds = shift; # Reference to the metadatas + my @array; # The array of hashes, to be returned + foreach my $md (@$mds) { + my $values = md2hash($md->{value}); + push @array, $values; + } + return \@array; +} + +# Convert the metadata to a hash; in effect, strips out the comment, type and class fields. +sub md2hash +{ + my $values = shift; # Reference to the metadata + my %hash; # Hash, to be returned + foreach my $data (@$values) { + $hash{$data->{name}} = $data->{value}; + } + return \%hash; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_copy.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_copy.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_copy.pl (revision 41105) @@ -0,0 +1,189 @@ +#!/usr/bin/env perl + +#This is essentially the same as minidvodb_copy.pl - the tables are essentially identical, and the task (to rsync a copy) is essentially identical. A new script was created for rsyncing the merges in case they should diverge in the future. + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +print "\n\n"; +print "Starting script $0 on $host\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; + +my $dtime; +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $rsync = can_run('rsync') or (warn "Can't find rsync" and $missing_tools = 1); +my $mergedvodbtool = can_run('mergedvodbtool') or (warn "Can't find mergedvodbtool" and $missing_tools = 1); +my $ssh = can_run('ssh') or (warn "Can't find ssh" and $missing_tools = 1); +my $df = can_run('df') or (warn "Can't find df" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + + + +my ( $mergedvodbcopy_id, $merge_id, $mergedvodbrun_path, $mergedvodb_rsync_path, $destination_host, $dbname,$verbose, $logfile, $no_op, $redirect, $save_temps); +GetOptions( + 'mergedvodbcopy_id|w=s' => \$mergedvodbcopy_id, #minidvodb database + 'merge_id|w=s' => \$mergedvodb_id, #minidvodb_id + 'mergedvodbrun_path|w=s' => \$mergedvodbrun_path, #minidvodb_id + 'mergedvodb_rsync_path|w=s' => \$mergedvodb_rsync_path, + 'destination_host|w=s' => \$destination_host, + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --mergedvodbcopy_id --mergedvodb_rsync_path --mergedvodbrun_path --destination_host", + -exitval => 3, + ) unless + defined $mergedvodbcopy_id and + defined $mergedvodb_rsync_path and + defined $mergedvodbrun_path and + defined $destination_host; + + + +my $ipprc = PS::IPP::Config->new(); + +my @df; + + +if ($logfile) { + $ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $mergedvodbcopy_id, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + + +{ #can we rsync? + + my $sizes = `du -sk $mergedvodbrun_path`; + my $total = 0; + for(split /[\r\n]+/,$sizes) # split on one or more newline characters + { + my($number,$file) = split /\t/,$_,2; # split on tab ($file not used here) + $total += $number; + } +#print 'Total: '.$total; +{ + print "Checking available diskspace on $destination_host\n\n"; + + my $command = "$ssh $destination_host df $mergedvodb_rsync_path"; + print "$command\n\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform '$ssh $destination_host df $mergedvodb_rsync_path' $error_code", $minidvodbcopy_id, $error_code); + } + + my @fullbuf= split(/\n/, @{$stdout_buf}[0]); + # print $#{$stdout_buf}; +# print "xx $#df xx"; +# print $fullbuf[0]; + if ($#fullbuf ==1 ) { +# print $fullbuf[1]; + @df = split /\s+/, $fullbuf[1]; + if ($#df == 5) { +# + #print $df[3], $df[4]; + + $df[4]=~ s/\%//; + + if ($df[4] < 97 && $df[3]-$total) { + print "\nThere is enough available space ($total < $df[3]) for the rsync\n"; + } else { + &my_die("Not enough available disk space: $df[4]% available, $df[3] on destination, $total free required for copy", $mergedvodbcopy_id, $PS_EXIT_PROG_ERROR); + } +# + + } else { + &my_die("Cannot parse df:\n@{$full_buf}[0]\nCan't figure out %free or available", $mergedvodbcopy_id, $PS_EXIT_PROG_ERROR); + } + } else { + &my_die("Cannot parse df:\n@{$full_buf}[0]\nToo many lines ($#fullbuf) vs 1", $mergedvodbcopy_id, $PS_EXIT_PROG_ERROR); + } +} +} + +{#do the rsync + my $command = "$rsync -rvuaq"; + $command .= " $mergedvodbrun_path"; + $command .= " $destination_host"; + $command .= ":$mergedvodb_rsync_path"; + print "\nPerforming rsync:\n"; + print "$command\n\n"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform rsync: $error_code", $mergedvodbcopy_id, $error_code); + } + + print "Rsync complete..\n"; + +} + +{#update the database + $dtime = 86400.0*(DateTime->now->mjd - $mjd_start); + + my $command = "$mergedvodbtool -updatemergedvodbcopy -mergedvodbcopy_id $mergedvodbcopy_id"; + $command .= " -set_state full -set_dtime $dtime"; + $command .= " -dbname $dbname" if defined $dbname; + print "$command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = 20; + &my_die("Unable to update database - rsync completed without error' $error_code", $mergedvodbcopy_id, $error_code); + } + +} +exit 0; + + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $mergedbvodbcopy_id = shift; + my $exit_code = shift; # Exit code to add + + print STDERR "$msg $mergedvodbcopy_id\n"; + +if (defined $mergedvodb_id ) { + my $command = "mergedvodbtool -updatemergedvodbcopy -mergedvodbcopy_id $mergedvodbcopy_id"; + $command .= " -set_fault $exit_code"; + $command .= " -set_dtime $dtime" if defined $dtime; + $command .= " -dbname $dbname" if defined $dbname; + print $command; + system ($command); + } + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_merge.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_merge.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_merge.pl (revision 41105) @@ -0,0 +1,238 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +print "\n\n"; +print "Starting script $0 on $host\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script +my $dtime_merge; +my $dtime_verify; +my $dtime_script; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dvomerge = can_run('dvomerge') or (warn "Can't find dvomerge" and $missing_tools = 1); +my $mergetool = can_run('mergetool') or (warn "Can't find mergetool" and $missing_tools = 1); +my $dvoverify = can_run('dvoverify') or (warn "Can't find dvoverify" and $missing_tools = 1); + + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $mergedvodb_path, $merge_id, $mergedvodb, $minidvodb_path, $dbname,$camera,$verbose, $logfile, $no_op, $redirect, $save_temps); +GetOptions( + 'mergedvodb_path|w=s' => \$mergedvodb_path, # output DVO database + 'minidvodb_path|w=s' => \$minidvodb_path, #minidvodb database + 'mergedvodb|w=s' => \$mergedvodb, #mergedvodb + 'merge_id|w=s' => \$merge_id, #minidvodb_id + 'dbname|d=s' => \$dbname, # Database name + 'camera|w=s' => \$camera, #camera name + 'verbose' => \$verbose, # Print to stdout + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --merge_id -- minidvodb_path --mergedvodb_path --mergedvodb --camera", + -exitval => 3, + ) unless + defined $mergedvodb_path and + defined $minidvodb_path and + defined $mergedvodb and + defined $merge_id and + defined $camera; + + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $merge_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +if ($logfile) { + $ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $merge_id, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + +# convert supplied DVO database name to UNIX filename + +unless ($no_op) { + + #this is chopped into several parts: firstcheck, addstar, relphot, dvoverify, merge + + #first check that there were no faulted merges before. If there are, fault this merge with PS_EXIT_UNKNOWN_ERROR + { + my $nothing_faulted = 0; + my $mdcParser = PS::IPP::Metadata::Config->new; + my $command = "$mergetool -listmerged -faulted -mergedvodb " . $mergedvodb; + $command .= " -dbname $dbname" if defined $dbname; + print "looking for faulted:\n\n$command\n\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get list of faulted mergedvodbs", $merge_id, $PS_EXIT_SYS_ERROR) unless $success; + if (scalar @$stdout_buf == 0 ) { #it lists nothing if nothign has faulted + $nothing_faulted =1; + print "previous merges are okay.\n"; + } + &my_die( "Previous merges faulted, do not proceed until they are investigated:", $merge_id, $PS_EXIT_UNKNOWN_ERROR) unless $nothing_faulted; + } + { + my $command = "$dvoverify -s $minidvodb_path"; + print "$command\n"; + my $mjd_dvoverify_start = DateTime->now->mjd; # MJD of starting script + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dvoverify: $error_code", $merge_id, $error_code); + } + $dtime_verify = 86400.0*(DateTime->now->mjd - $mjd_dvoverify_start); # MJD of starting script + print "dvoverify time $dtime_verify\n"; + } + #Merge + + my $this_is_the_first; + { + + my $mdcParser = PS::IPP::Metadata::Config->new; + my $command = "$mergetool -listmerged -mergedvodb " . $mergedvodb; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get list of mergedvodbruns", $merge_id, $PS_EXIT_SYS_ERROR) unless $success; + if (scalar @$stdout_buf == 0 ) { #it lists nothing if it is the first + $this_is_the_first =1; + print "listing nothing\n"; + } else { + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $merge_id, $PS_EXIT_PROG_ERROR); + #this fails if there is nothing listed. I checked. + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $merge_id, $PS_EXIT_PROG_ERROR); + my $comp = $$components[0]; + my $mergedvodb_path_tmp = $comp->{mergedvodb_path}; + + if (!defined($mergedvodb_path_tmp)) { + &my_die("Unable to parse mergedvodb_path", $merge_id, $PS_EXIT_PROG_ERROR); + } #but just to make sure, have it grab a minidvodb_name, to make sure it's not junk. + print "found at least 1 mergedvodbrun in merged state\n"; + $this_is_the_first = 0; + } + } + print "$this_is_the_first $mergedvodb_path/Image.dat\n"; + if (-e "$mergedvodb_path/Image.dat") { + if ($this_is_the_first == 1) { + &my_die("refusing to merge, this is the first, but files already exist in dir", $merge_id, 4); + } + $this_is_the_first =0; + } + + print "$this_is_the_first $mergedvodb_path/Image.dat\n"; + { + my $merge_command; + my $mjd_merge_start = DateTime->now->mjd; # MJD of starting script + if ($this_is_the_first) { + $merge_command = "rsync -rvat $minidvodb_path/* $mergedvodb_path"; + } else { +# $merge_command = "$dvomerge -parallel $minidvodb_path into $mergedvodb_path"; + $merge_command = "$dvomerge -matched-tables $minidvodb_path into $mergedvodb_path"; + } + print "\n$merge_command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $merge_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to merge: $error_code", $merge_id, $error_code); + } + $dtime_merge = 86400.0*(DateTime->now->mjd - $mjd_merge_start); # MJD of starting script + print "merge time $dtime_merge\n"; +# } + } + + { + + $dtime_script = 86400.0*(DateTime->now->mjd - $mjd_start); + my $command = "mergetool -merge_id $merge_id"; + $command .= " -addmerged"; + $command .= " -mergedvodb $mergedvodb" if defined $mergedvodb; +# $command .= " -mergedvodb_path $mergedvodb_path" if defined $mergedvodb_path; + $command .= " -dtime_merge $dtime_merge" if defined $dtime_merge; + $command .= " -dtime_script $dtime_script" if defined $dtime_script; + $command .= " -dtime_verify $dtime_verify" if defined $dtime_verify; + $command .= " -dbname $dbname" if defined $dbname; + #print $command; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to add to mergedvodbprocessed: $error_code", $merge_id, $error_code); + } + } + +#} else { +# &my_die("dvodb: $mergedvodb_path not found", $merge_id, $PS_EXIT_UNKNOWN_ERROR); +} +else { + print "skipping processing for $mergedvodb_path\n"; +} + +exit 0; + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $merge_id = shift; + my $exit_code = shift; # Exit code to add + + print STDERR "$msg $mergedvodb_path\n"; + +if (defined $merge_id ) { + + my $command = "mergetool -merge_id $merge_id"; + $command .= " -addmerged"; + $command .= " -mergedvodb $mergedvodb" if defined $mergedvodb; + $command .= " -fault $exit_code"; + #$command .= " -mergedvodb_path $mergedvodb_path" if defined $mergedvodb_path; + $command .= " -dtime_merge $dtime_merge" if defined $dtime_merge; + $command .= " -dtime_script $dtime_script" if defined $dtime_script; + $command .= " -dtime_verify $dtime_verify" if defined $dtime_verify; + $command .= " -dbname $dbname" if defined $dbname; + + + + print $command; + system ($command); + } + + + + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_queue.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_queue.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/mergedvodb_queue.pl (revision 41105) @@ -0,0 +1,164 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; +use DateTime; + +# Ideally, we want to queue new runs with mergetool -definebyquery. We can't for the survey task, because we use the value in 'site.config' to find the mergedvodb_path. I do not know how to tell pantasks how to do this, but I know how to do it in perl. + + +use DateTime::Format::Strptime; +use DateTime::Duration; +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + + +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $mergetool = can_run('mergetool') or (warn "Can't find mergetool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $outroot, $dbname, $minidvodb_group, $mergedvodb , $camera, $verbose, $no_update, + $no_op, $redirect, $save_temps); + +# we just need any old camera to be able to read site.config. I'm using SIMPLE, unless it is overridden on the commandline (it makes no difference for this case) + +$camera = 'SIMPLE'; + + +GetOptions( + 'camera|c=s' => \$camera, # Camera + 'dbname|d=s' => \$dbname, # Database name + 'minidvodb_group|w=s' => \$minidvodb_group, # minidvodb_group. + 'outroot|w=s' => \$outroot, # output file base name + 'mergedvodb|w=s' => \$mergedvodb, # output miniDVODB + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --mergedvodb --minidvodb_group --outroot", + -exitval => 3, + ) unless + defined $minidvodb_group and + # defined $camera and + defined $outroot and + defined $mergedvodb; + +print "camera is $camera\n"; + + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $mergedvodb , $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot) or &my_die("Missing entry from camera config", $minidvodb_group, $PS_EXIT_CONFIG_ERROR); +print "log file is $logDest\n"; +if ($redirect) { + $ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $minidvodb_group, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + + +# Recipes to use based on reduction class + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Output products +$ipprc->outroot_prepare($outroot); + +# the camera configurations should define the psastro output to be a single file (MEF), regardless of the inputs + my $create_new = 0; +# convert supplied DVO database name to UNIX filename +my $mergedvodbReal; +if (defined $mergedvodb) { + $mergedvodbReal = $ipprc->dvo_catdir( $mergedvodb ); # catdir for DVO + $mergedvodbReal = $ipprc->convert_filename_absolute( $mergedvodbReal ); +} else { + warn("mergedvodb undefined:\n"); + exit(4); +} +if (!defined $mergedvodbReal) { + warn("can't parse out mergedvodb_path\n"); + exit(4); +} + + + +print "mergedvodb_path = $mergedvodbReal\n"; + +unless ($no_op) { + + #create the mergedvodb entry (well, the command for it) + my $fpaCommand = "$mergetool -definebyquery"; + $fpaCommand .= " -mergedvodb $mergedvodb"; + $fpaCommand .= " -minidvodb_group $minidvodb_group"; + $fpaCommand .= " -set_mergedvodb_path $mergedvodbReal" ; + $fpaCommand .= " -dbname $dbname" if defined $dbname; + + print "running the following: \n\n"; + print "$fpaCommand\n\n"; + + unless ($no_update) { + + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $fpaCommand, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to add result to database: $error_code\n"); + exit($error_code); + } + } else { + print "skipping command: $fpaCommand\n"; + } +} + +sub my_die +{#complain if it doesn't work + my $msg = shift; # Warning message on die + my $mergedvodb = shift; # Camtool identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_copy.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_copy.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_copy.pl (revision 41105) @@ -0,0 +1,219 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +print "\n\n"; +print "Starting script $0 on $host\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; + +my $dtime; +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $rsync = can_run('rsync') or (warn "Can't find rsync" and $missing_tools = 1); +my $minidvodbtool = can_run('minidvodbtool') or (warn "Can't find minidvodbtool" and $missing_tools = 1); +my $ssh = can_run('ssh') or (warn "Can't find ssh" and $missing_tools = 1); +my $df = can_run('df') or (warn "Can't find df" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + + + +my ( $minidvodbcopy_id, $minidvodb_id, $minidvodbrun_path, $minidvodb_rsync_path, $destination_host, $dbname,$verbose, $logfile, $no_op, $redirect, $save_temps); +GetOptions( + 'minidvodbcopy_id|w=s' => \$minidvodbcopy_id, #minidvodb database + 'minidvodb_id|w=s' => \$minidvodb_id, #minidvodb_id + 'minidvodbrun_path|w=s' => \$minidvodbrun_path, #minidvodb_id + 'minidvodb_rsync_path|w=s' => \$minidvodb_rsync_path, + 'destination_host|w=s' => \$destination_host, + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --minidvodbcopy_id --minidvodb_rsync_path --minidvodbrun_path --destination_host", + -exitval => 3, + ) unless + defined $minidvodbcopy_id and + defined $minidvodb_rsync_path and + defined $minidvodbrun_path and + defined $destination_host; + + + +my $ipprc = PS::IPP::Config->new(); + +my @df; + + +if ($logfile) { + $ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $minidvodbcopy_id, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + + +{ #can we rsync? + + my $sizes = `du -sk $minidvodbrun_path`; + my $total = 0; + for(split /[\r\n]+/,$sizes) # split on one or more newline characters + { + my($number,$file) = split /\t/,$_,2; # split on tab ($file not used here) + $total += $number; + } +#print 'Total: '.$total; +{ + print "Checking available diskspace on $destination_host\n\n"; + + my $command = "$ssh $destination_host df $minidvodb_rsync_path"; + print "$command\n\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform '$ssh $destination_host df $minidvodb_rsync_path' $error_code", $minidvodbcopy_id, $error_code); + } + + my @fullbuf= split(/\n/, @{$stdout_buf}[0]); + # print $#{$stdout_buf}; +# print "xx $#df xx"; +# print $fullbuf[0]; + if ($#fullbuf ==1 ) { +# print $fullbuf[1]; + @df = split /\s+/, $fullbuf[1]; + if ($#df == 5) { +# + #print $df[3], $df[4]; + + $df[4]=~ s/\%//; + + if ($df[4] < 97 && $df[3]-$total) { + print "\nThere is enough available space ($total < $df[3]) for the rsync\n"; + } else { + &my_die("Not enough available disk space: $df[4]% available, $df[3] on destination, $total free required for copy", $minidvodbcopy_id, $PS_EXIT_PROG_ERROR); + } +# + + } else { + &my_die("Cannot parse df:\n@{$full_buf}[0]\nCan't figure out %free or available", $minidvodbcopy_id, $PS_EXIT_PROG_ERROR); + } + } else { + &my_die("Cannot parse df:\n@{$full_buf}[0]\nToo many lines ($#fullbuf) vs 1", $minidvodbcopy_id, $PS_EXIT_PROG_ERROR); + } +} +} + +{#do the rsync + my $command = "$rsync -rvuaq"; + $command .= " $minidvodbrun_path"; + $command .= " $destination_host"; + $command .= ":$minidvodb_rsync_path"; + print "\nPerforming rsync:\n"; + print "$command\n\n"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform rsync: $error_code", $minidvodbcopy_id, $error_code); + } + + print "Rsync complete..\n"; + +} + +{#update the database + $dtime = 86400.0*(DateTime->now->mjd - $mjd_start); + + my $command = "$minidvodbtool -updateminidvodbcopy -minidvodbcopy_id $minidvodbcopy_id"; + $command .= " -set_state full -set_dtime $dtime"; + $command .= " -dbname $dbname" if defined $dbname; + print "$command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = 20; + &my_die("Unable to update database - rsync completed without error' $error_code", $minidvodbcopy_id, $error_code); + } + +} + + + + + + + + + +#if ($logfile) { +# $ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $minidvodbcopy_id, $PS_EXIT_SYS_ERROR ); +# print "\n\n"; +# print "Starting script $0 on $host\n\n"; +# print "COMMAND IS: @ARGV\n\n"; +#} + + + + +exit 0; + + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $minidbvodbcopy_id = shift; + my $exit_code = shift; # Exit code to add + + print STDERR "$msg $minidvodbcopy_id\n"; + +if (defined $minidvodb_id ) { + + my $command = "minidvodbtool -updateminidvodbcopy -minidvodbcopy_id $minidvodbcopy_id"; + + $command .= " -set_fault $exit_code"; + $command .= " -set_dtime $dtime" if defined $dtime; + $command .= " -dbname $dbname" if defined $dbname; + + + + print $command; + system ($command); + } + + + + + + + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_createdb.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_createdb.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_createdb.pl (revision 41105) @@ -0,0 +1,269 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; +use DateTime; + +use DateTime::Format::Strptime; +use DateTime::Duration; +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + + +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $addtool = can_run('addtool') or (warn "Can't find addtool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $outroot, $dbname, $dvodb, $minidvodb,$minidvodb_interval, $minidvodb_nums, $minidvodb_group, $camera, $verbose, $no_update, + $no_op, $redirect, $save_temps); +GetOptions( + 'camera|c=s' => \$camera, # Camera + 'dbname|d=s' => \$dbname, # Database name + 'minidvodb_group|w=s' => \$minidvodb_group, # minidvodb_group. + 'outroot|w=s' => \$outroot, # output file base name + 'dvodb|w=s' => \$dvodb, # output DVO database + 'minidvodb|w=s' => \$minidvodb, # output miniDVODB + 'interval|w=s' => \$minidvodb_interval, #interval between creation of minidvodbs (default = 1day) + 'num|w=s' => \$minidvodb_nums, #interval between creation of minidvodbs (default = 500 addRuns) + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --camera --dvodb --minidvodb_group --outroot", + -exitval => 3, + ) unless + defined $minidvodb_group and + defined $camera and + defined $outroot and + defined $dvodb; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $minidvodb_group , $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot) or &my_die("Missing entry from camera config", $minidvodb_group, $PS_EXIT_CONFIG_ERROR); + +if ($redirect) { + $ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $minidvodb_group, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + + +# Recipes to use based on reduction class + +# XXX This is now not used: do we still need it? + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Output products +$ipprc->outroot_prepare($outroot); + +# the camera configurations should define the psastro output to be a single file (MEF), regardless of the inputs + my $create_new = 0; +# convert supplied DVO database name to UNIX filename +my $dvodbReal; +if (defined $dvodb) { + $dvodbReal = $ipprc->dvo_catdir( $dvodb ); # catdir for DVO + $dvodbReal = $ipprc->convert_filename_absolute( $dvodbReal ); +} else { + warn("dvodb undefined:\n"); + exit(4); +} +my $minidvodbReal; +if (defined $minidvodb) { + $minidvodbReal = $ipprc->dvo_catdir( $minidvodb ); # catdir for DVO + $minidvodbReal = $ipprc->convert_filename_absolute( $minidvodbReal ); +} else { + warn("minidvodb undefined:\n"); + exit(4); +} + + +if (!defined $minidvodb_interval) { + $minidvodb_interval = 1; +} +if (!defined $minidvodb_nums) { + $minidvodb_nums = 500 +} + + +unless ($no_op) { + + + +#see if there is already one in new state + my $fpaCommand1 = "$addtool -listminidvodbrun"; + $fpaCommand1 .= " -minidvodb_group '$minidvodb_group'"; + $fpaCommand1 .= " -state 'new'"; + $fpaCommand1 .= " -dbname $dbname" if defined $dbname; + + +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $fpaCommand1, verbose => $verbose); + + + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to list minidvodb database: $error_code\n"); + exit($error_code); + } + + if (scalar(@{$stdout_buf})) { + $error_code = 3; + warn("Unwilling to create minidvodb, one already exists in new state: $error_code\n"); + exit($error_code); + } + + my $creation_date; + my $addRun_count; + my $minidvodb_name; +#find the active one's date, and find out if it has more than 1 addRun in it + + my $fpaCommand2 = "$addtool -listminidvodbrun"; + $fpaCommand2 .= " -minidvodb_group '$minidvodb_group'"; + $fpaCommand2 .= " -state 'active'"; + $fpaCommand2 .= " -limit 1"; + $fpaCommand2 .= " -dbname $dbname" if defined $dbname; + +#print $fpaCommand2; + + + my ( $success2, $error_code2, $full_buf2, $stdout_buf2, $stderr_buf2 ) = + run(command => $fpaCommand2, verbose => $verbose); + &my_die( "Unable to get listminidvodbrun",$minidvodb_group, $PS_EXIT_SYS_ERROR) unless $success2; + # if it didn't list something in active state (what?) then we definitely need to create a new one + if (defined(@$stdout_buf2)) { + my $metadata2 = $mdcParser->parse(join "", @$stdout_buf2) or + &my_die("Unable to parse metadata config", $minidvodb_group, $PS_EXIT_PROG_ERROR); + + my $components2 = parse_md_list($metadata2) or + &my_die("Unable to parse metadata list", $minidvodb_group, $PS_EXIT_PROG_ERROR); + my $comp2 = $$components2[0]; + $minidvodb_name = $comp2->{minidvodb_name}; + $creation_date = $comp2->{creation_date}; + if (!defined($minidvodb_name)) { + &my_die("Unable to parse minidvodb_name", $minidvodb_group, $PS_EXIT_PROG_ERROR); + } + if (!defined($creation_date)) { + &my_die("Unable to parse creation_date", $minidvodb_group, $PS_EXIT_PROG_ERROR); + } + } else { + $create_new = 1; #this is to force it to make a new one + } + + #find the number of add_ids that have been proccessed + my $fpaCommand3 = "$addtool -checkminidvodbrunaddrun"; + $fpaCommand3 .= " -minidvodb_group '$minidvodb_group'"; + $fpaCommand3 .= " -state 'active'"; + $fpaCommand3 .= " -minidvodb_name '$minidvodb_name'" if defined $minidvodb_name; + $fpaCommand3 .= " -limit 1"; + $fpaCommand3 .= " -dbname $dbname" if defined $dbname; + + +my ( $success3, $error_code3, $full_buf3, $stdout_buf3, $stderr_buf3 ) = + run(command => $fpaCommand3, verbose => $verbose); + &my_die( "Unable to get checkminidvodbunaddrun", $minidvodb_group, $PS_EXIT_SYS_ERROR) unless $success3; + + if (defined(@$stdout_buf3)) { #checkminidvodb returns nothing IF there have been no addruns added to the db yet + my $metadata3 = $mdcParser->parse(join "", @$stdout_buf3) or + &my_die("Unable to parse metadata config", $minidvodb_group, $PS_EXIT_PROG_ERROR); + + my $components3 = parse_md_list($metadata3) or + &my_die("Unable to parse metadata list", $minidvodb_group, $PS_EXIT_PROG_ERROR); + my $comp = $$components3[0]; + $addRun_count = $comp->{addRun_count}; + } + if (!defined($addRun_count)) { + ## there's nothing to parse if there's nothing + $addRun_count = 0; + } + + + if ($addRun_count > $minidvodb_nums) { + #it's too big, create_new + $create_new = 1; + } + if ($create_new == 0) { + my $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%dT%H:%M:%S', time_zone => "HST" ); + my $creation_dt = $parser->parse_datetime( $creation_date )->mjd; + if ($mjd_start- $creation_dt > $minidvodb_interval && $addRun_count > 0 ) { + #db is old and has stuff in it, want to create_new + $create_new = 1; + } + } + + +} +#create the minidvodb entry (well, the command for it) + my $fpaCommand = "$addtool -addminidvodbrun"; + $fpaCommand .= " -set_minidvodb_group $minidvodb_group"; + $fpaCommand .= " -set_minidvodb_path $minidvodbReal" if defined $minidvodbReal; + $fpaCommand .= " -dbname $dbname" if defined $dbname; + + unless ($no_update or !$create_new) { + + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $fpaCommand, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to add result to database: $error_code\n"); + exit($error_code); + } + } else { + print "skipping command: $fpaCommand\n"; + } +} + +sub my_die +{#complain if it doesn't work + my $msg = shift; # Warning message on die + my $minidvodb_group = shift; # Camtool identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_merge.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_merge.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_merge.pl (revision 41105) @@ -0,0 +1,312 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +print "\n\n"; +print "Starting script $0 on $host\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script +my $dtime_resort; +my $dtime_relphot; +my $dtime_merge; +my $dtime_verify; +my $dtime_script; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dvomerge = can_run('dvomerge') or (warn "Can't find dvomerge" and $missing_tools = 1); +my $addtool = can_run('addtool') or (warn "Can't find addtool" and $missing_tools = 1); +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); +my $relphot = can_run('relphot') or (warn "Can't find relphot" and $missing_tools = 1); +my $relastro = can_run('relastro') or (warn "Can't find relastro" and $missing_tools = 1); +my $dvoverify = can_run('dvoverify') or (warn "Can't find dvoverify" and $missing_tools = 1); + + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $mergedvodb, $minidvodb, $minidvodb_id, $minidvodb_group, $camera, $dbname,$verbose, $logfile, $no_op, $redirect, $save_temps); +GetOptions( + 'mergedvodb|w=s' => \$mergedvodb, # output DVO database + 'minidvodb|w=s' => \$minidvodb, #minidvodb database + 'minidvodb_id|w=s' => \$minidvodb_id, #minidvodb_id + 'minidvodb_group|w=s' => \$minidvodb_group, #minidvodb_id + 'camera|c=s' => \$camera, # Camera + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --mergedvodb --minidvodb --minidvodb_id -- minidvodb_group --camera", + -exitval => 3, + ) unless + defined $mergedvodb and + defined $minidvodb and + defined $minidvodb_id and + defined $minidvodb_group and + defined $camera; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $mergedvodb, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +if ($logfile) { + $ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $mergedvodb, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + +# convert supplied DVO database name to UNIX filename +my $mergedvodbReal; +if (defined $mergedvodb) { + $mergedvodbReal = $ipprc->dvo_catdir( $mergedvodb ); # catdir for DVO + $mergedvodbReal = $ipprc->convert_filename_absolute( $mergedvodbReal ); +} + +my $dtime_addstar = 0; +#my $dtime_relphot = 0; + +unless ($no_op) { + if (defined $mergedvodbReal) { + + #this is chopped into several parts: firstcheck, addstar, relphot, dvoverify, merge + + #first check that there were no faulted merges before. If there are, fault this merge with PS_EXIT_UNKNOWN_ERROR + { + my $nothing_faulted = 0; + my $mdcParser = PS::IPP::Metadata::Config->new; + + my $command = "$addtool -listminidvodbprocessed -faulted -minidvodb_group " . $minidvodb_group; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get list of faulted minidvodbs", $minidvodb_id, $PS_EXIT_SYS_ERROR) unless $success; + if (scalar @$stdout_buf == 0 ) { #it lists nothing if nothign has faulted + $nothing_faulted =1; + print "previous merges are okay.\n"; + } + &my_die( "Previous merges faulted, do not proceed until they are investigated:", $minidvodb_group, $PS_EXIT_UNKNOWN_ERROR) unless $nothing_faulted; + + + + } + + #addstar + { + my $command = "$addstar -resort"; + $command .= " -D CAMERA $camera"; + $command .= " -D CATDIR $minidvodb"; + + my $mjd_addstar_start = DateTime->now->mjd; # MJD of starting script + print "\n$command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform addstar: $error_code", $mergedvodb, $error_code); + } + $dtime_addstar = 86400.0*(DateTime->now->mjd - $mjd_addstar_start); $dtime_resort = $dtime_addstar; + # MJD of starting script + $dtime_resort = $dtime_addstar; + print "addstar -resort time $dtime_addstar\n"; + } + + #relphot + + { + # relphot only takes lower case gpc1 + my $relphot_camera = lc($camera); + my $command = "$relphot -averages -update"; + $command .= " -D CAMERA $relphot_camera"; + $command .= " -D CATDIR $minidvodb"; + print "$command\n"; + my $mjd_relphot_start = DateTime->now->mjd; # MJD of starting script + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform relphot: $error_code", $mergedvodb, $error_code); + } + $dtime_relphot = 86400.0*(DateTime->now->mjd - $mjd_relphot_start); # MJD of starting script + print "relphot time $dtime_relphot\n"; + } + #dvoverify + { + my $command = "$dvoverify -s $minidvodb"; + print "$command\n"; + my $mjd_dvoverify_start = DateTime->now->mjd; # MJD of starting script + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dvoverify: $error_code", $mergedvodb, $error_code); + } + $dtime_verify = 86400.0*(DateTime->now->mjd - $mjd_dvoverify_start); # MJD of starting script + print "dvoverify time $dtime_verify\n"; + } + + + #Merge + + my $this_is_the_first; + { + + my $mdcParser = PS::IPP::Metadata::Config->new; + + my $command = "$addtool -listminidvodbrun -state merged -minidvodb_group " . $minidvodb_group; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get list of minidvodbruns", $minidvodb_id, $PS_EXIT_SYS_ERROR) unless $success; + if (scalar @$stdout_buf == 0 ) { #it lists nothing if it is the first + $this_is_the_first =1; + print "listing nothing\n"; + } else { + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $minidvodb_id, $PS_EXIT_PROG_ERROR); + #this fails if there is nothing listed. I checked. + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $minidvodb_id, $PS_EXIT_PROG_ERROR); + my $comp = $$components[0]; + my $minidvodb_name = $comp->{minidvodb_name}; + + if (!defined($minidvodb_name)) { + &my_die("Unable to parse minidvodb_name", $minidvodb_id, $PS_EXIT_PROG_ERROR); + } #but just to make sure, have it grab a minidvodb_name, to make sure it's not junk. + print "found at least 1 minidvodbrun in merged state\n"; + $this_is_the_first = 0; + } + } + print "$this_is_the_first $mergedvodb/Image.dat\n"; + + + if (-e "$mergedvodb/Image.dat") { + if ($this_is_the_first == 1) { + &my_die("refusing to merge, this is the first, but files already exist in dir", $minidvodb_id, 4); + } + $this_is_the_first =0; + } + + print "$this_is_the_first $mergedvodb/Image.dat\n"; + { + my $merge_command; + my $mjd_merge_start = DateTime->now->mjd; # MJD of starting script + if ($this_is_the_first) { + + $merge_command = "rsync -rvat $minidvodb/* $mergedvodb"; + } else { + $merge_command = "$dvomerge $minidvodb into $mergedvodb"; + } + + print "\n$merge_command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $merge_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to merge: $error_code", $mergedvodb, $error_code); + } + + $dtime_merge = 86400.0*(DateTime->now->mjd - $mjd_merge_start); # MJD of starting script + print "merge time $dtime_merge\n"; +# } + } + + { + + $dtime_script = 86400.0*(DateTime->now->mjd - $mjd_start); + + + my $command = "addtool -minidvodb_id $minidvodb_id"; + $command .= " -addminidvodbprocessed"; + $command .= " -mergedvodb_path $mergedvodbReal" if defined $mergedvodbReal; + $command .= " -minidvodb_group $minidvodb_group"; + $command .= " -dtime_relphot $dtime_relphot" if defined $dtime_relphot; + $command .= " -dtime_resort $dtime_resort" if defined $dtime_resort; + $command .= " -dtime_merge $dtime_merge" if defined $dtime_merge; + $command .= " -dtime_script $dtime_script" if defined $dtime_script; + $command .= " -dtime_verify $dtime_verify" if defined $dtime_verify; + $command .= " -dbname $dbname" if defined $dbname; + #print $command; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to add to minidvodbprocessed: $error_code", $mergedvodb, $error_code); + } + } + + } else { + &my_die("dvodb: $mergedvodb not found", $mergedvodb, $PS_EXIT_UNKNOWN_ERROR); + } +} else { + print "skipping processing for $mergedvodbReal\n"; +} + +exit 0; + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $minidbvodb_id = shift; + my $exit_code = shift; # Exit code to add + + print STDERR "$msg $mergedvodb\n"; + +if (defined $minidvodb_id ) { + + my $command = "addtool -minidvodb_id $minidvodb_id"; + $command .= " -addminidvodbprocessed"; + $command .= " -fault $exit_code"; + $command .= " -mergedvodb_path $mergedvodbReal" if defined $mergedvodbReal; + $command .= " -minidvodb_group $minidvodb_group"; + $command .= " -dtime_relphot $dtime_relphot" if defined $dtime_relphot; + $command .= " -dtime_resort $dtime_resort" if defined $dtime_resort; + $command .= " -dtime_merge $dtime_merge" if defined $dtime_merge; + $command .= " -dtime_script $dtime_script" if defined $dtime_script; + $command .= " -dtime_verify $dtime_verify" if defined $dtime_verify; + $command .= " -dbname $dbname" if defined $dbname; + + + + #print $command; + system ($command); + } + + + + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_premerge.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_premerge.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/minidvodb_premerge.pl (revision 41105) @@ -0,0 +1,199 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +print "\n\n"; +print "Starting script $0 on $host\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script +my $dtime_resort; +my $dtime_relphot; +my $dtime_script; +my $dtime_delstar; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dvomerge = can_run('dvomerge') or (warn "Can't find dvomerge" and $missing_tools = 1); +my $addtool = can_run('addtool') or (warn "Can't find addtool" and $missing_tools = 1); +my $delstar = can_run('delstar') or (warn "Can't find delstar" and $missing_tools = 1); +my $addstar = can_run('addstar') or (warn "Can't find addstar" and $missing_tools = 1); +my $relphot = can_run('relphot') or (warn "Can't find relphot" and $missing_tools = 1); +my $relastro = can_run('relastro') or (warn "Can't find relastro" and $missing_tools = 1); + +my $dvoverify = can_run('dvoverify') or (warn "Can't find dvoverify" and $missing_tools = 1); + + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ( $minidvodb, $minidvodb_id, $minidvodb_group, $camera, $dbname,$verbose, $logfile, $no_op, $redirect, $save_temps); +GetOptions( + 'minidvodb|w=s' => \$minidvodb, #minidvodb database + 'minidvodb_id|w=s' => \$minidvodb_id, #minidvodb_id + 'minidvodb_group|w=s' => \$minidvodb_group, #minidvodb_id + 'camera|c=s' => \$camera, # Camera + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-op' => \$no_op, # Don't do any operations? + 'logfile=s' => \$logfile, + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --minidvodb --minidvodb_id -- minidvodb_group --camera", + -exitval => 3, + ) unless + defined $minidvodb and + defined $minidvodb_id and + defined $minidvodb_group and + defined $camera; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $minidvodb_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +if ($logfile) { + $ipprc->redirect_output($logfile) or my_die( "Unable to redirect output", $minidvodb_id, $PS_EXIT_SYS_ERROR ); + print "\n\n"; + print "Starting script $0 on $host\n\n"; + print "COMMAND IS: @ARGV\n\n"; +} + +my $dtime_addstar = 0; + +unless ($no_op) { + + #this is chopped into several parts: delstar,addstar, relphot, relastro, dvoverify + #delstar - first step: are there duplicates, if so remove them +# { +# my $command = "$delstar -update -dup-images -skip-diff-pairs"; +# $command .= " -D CATDIR $minidvodb"; +# my $mjd_delstar_start = DateTime->now->mjd; # MJD of starting script +# print "\n$command\n"; +# my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run(command => $command, verbose => $verbose); +# unless ($success) { +# $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); +# &my_die("Unable to perform delstar: $error_code", $minidvodb_id, $error_code); +# } +# print $full_buf; +# $dtime_delstar = 86400.0*(DateTime->now->mjd - $mjd_delstar_start); + # MJD of starting script +# print "delstar time $dtime_delstar\n"; +# } + + + + #addstar + { + my $command = "$addstar -resort"; + $command .= " -D CAMERA $camera"; + $command .= " -D CATDIR $minidvodb"; + my $mjd_addstar_start = DateTime->now->mjd; # MJD of starting script + print "\n$command\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform addstar: $error_code", $minidvodb_id, $error_code); + } + $dtime_addstar = 86400.0*(DateTime->now->mjd - $mjd_addstar_start); + # MJD of starting script + $dtime_resort = $dtime_addstar; + print "addstar -resort time $dtime_addstar\n"; + } + + #relphot + + { + # relphot only takes lower case gpc1 + my $relphot_camera = lc($camera); + #my $command = "$relphot -averages -update"; + #$command .= " -D CAMERA $relphot_camera"; + #$command .= " -D CATDIR $minidvodb"; + #this is a friday hack + my $command = "echo skipping relphot"; + print "$command\n"; + my $mjd_relphot_start = DateTime->now->mjd; # MJD of starting script + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform relphot: $error_code", $minidvodb_id, $error_code); + } + $dtime_relphot = 86400.0*(DateTime->now->mjd - $mjd_relphot_start); # MJD of starting script + print "relphot time $dtime_relphot\n"; + } + + { + + $dtime_script = 86400.0*(DateTime->now->mjd - $mjd_start); + my $command = "addtool -minidvodb_id $minidvodb_id"; + $command .= " -addminidvodbprocessed"; + $command .= " -minidvodb_group $minidvodb_group"; + $command .= " -dtime_relphot $dtime_relphot" if defined $dtime_relphot; + $command .= " -dtime_resort $dtime_resort" if defined $dtime_resort; + $command .= " -dtime_script $dtime_script" if defined $dtime_script; + $command .= " -dbname $dbname" if defined $dbname; + #print $command; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to add to minidvodbprocessed: $error_code", $minidvodb_id, $error_code); + } + } +#} else { +# &my_die("dvodb: minidvodb_id = $minidvodb_id not found", $minidvodb_id, $PS_EXIT_UNKNOWN_ERROR); +#} +} else { + print "skipping processing for minidvodb_id = $minidvodb_id\n"; +} + +exit 0; + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $minidbvodb_id = shift; + my $exit_code = shift; # Exit code to add + print STDERR "$msg $minidvodb_id\n"; + +if (defined $minidvodb_id ) { + + my $command = "addtool -minidvodb_id $minidvodb_id"; + $command .= " -addminidvodbprocessed"; + $command .= " -fault $exit_code"; + $command .= " -minidvodb_group $minidvodb_group"; + $command .= " -dtime_relphot $dtime_relphot" if defined $dtime_relphot; + $command .= " -dtime_resort $dtime_resort" if defined $dtime_resort; + $command .= " -dtime_script $dtime_script" if defined $dtime_script; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/night_report.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/night_report.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/night_report.pl (revision 41105) @@ -0,0 +1,1238 @@ +#!/usr/bin/env perl + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +use DBI; +use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock'; # Socket for mysql + +# this saves the original arguments for later reporting +my @ARGS = @ARGV; + +GetOptions( + 'date=s' => \$date, + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'report' => \$report, # Formatted for ps-obs report + 'very-verbose' => \$verbose2, # Print to stdout + 'chunks' => \$chunks, # give information on the current status of the chunks + 'mopsreport' => \$mopsreport, # return a report in the new style requested by MOPS + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option(s): @ARGV", -exitval => 2 ) if @ARGV; + +# example if I require some options +# pod2usage( -msg => "Required options: --exp_id --chip_id", -exitval => 3) unless defined $exp_id and defined $chip_id; + +$date = `date --utc --rfc-3339=date` unless defined $date; +chomp $date; +$date=~ s/\//-/g; +$date=~ s/\./-/g; + +# database connection information: +$dbhost = 'ippdb08'; +$dbname = 'gpc1' unless defined $dbname; +$dbuser = 'ippuser'; +$dbpass = 'ippuser'; + +# dataGroupDate : formatted to match data_group values (YYYYMMDD) +$dataGroupDate = $date; +$dataGroupDate=~ s/-//g; +$dataGroupDate=~ s/\.//g; + +# set up the database connection: +my $dsn = "DBI:mysql:host=$dbhost;database=$dbname"; +my $dbh = DBI->connect( $dsn, $dbuser, $dbpass ) or die "Unable to connect to database: $DBI::errstr"; + +# find a useful exp_id (ALWAYS do this) +$refExpID = 0; +if (1) { + # print "Exposures 10 days ago:\n"; + + my $query = "SELECT MAX(exp_id)"; + $query .= " FROM rawExp"; + $query .= " WHERE dateobs >= date_sub('$date', interval 20 day)"; + $query .= " AND dateobs <= date_sub('$date', interval 10 day)"; + + my $result = &mysql_select ($query); + + @row = $result->fetchrow_array(); + $refExpID = $row[0]; + if ($refExpID eq "") { + $refExpID = 0; + print "*** WARNING: no data in period 10-20 days before requested date (query will be slower) **\n"; + } + if ($verbose2) { print "Reference exp_id: $refExpID\n"; } +} + +################## +# testing how to get more information parsed by chunk +if ($mopsreport or $report) { + print "\n\n\n"; + print "--- MOPS report for $dbname : $date ---\n\n"; + + my $badcamflag = 0; + my $badwarpflag = 0; + my $baddiffflag = 0; + + #do a query of raw/chip/cam/warp counts for this night, split by chunk. + #We want to stick to only MOPS products, so we do labels %SS%, %EU% and %Bright.% (to avoid BrightTwi and Bright3PI which are not in quads) + #we need to do a subquery to find the total number of skycells in warpSkyfile, as well as the number of those with a bad quality + my $query = "SELECT suba.chunk,suba.Nvis1,suba.Nvis2,suba.Nvis3,suba.Nvis4,suba.Ncamgood,suba.Ncambad,subb.Nwarpgood,subb.Nwarpbad FROM "; + $query .= " (SELECT substr(comment, 1, position(' ' in comment)) AS chunk,count(if(rawExp.comment LIKE '%visit 1%',1,NULL)) AS Nvis1,"; + $query .= " count(if(rawExp.comment LIKE '%visit 2%',1,NULL)) AS Nvis2,count(if(rawExp.comment LIKE '%visit 3%',1,NULL)) AS Nvis3,"; + $query .= " count(if(rawExp.comment LIKE '%visit 4%',1,NULL)) AS Nvis4, count(if(camProcessedExp.sigma_ra <= 5 AND camProcessedExp.sigma_dec <= 5 AND camProcessedExp.quality = 0,1,NULL)) AS Ncamgood,"; + $query .= " count(if(camProcessedExp.sigma_ra > 5 OR camProcessedExp.sigma_dec > 5 OR camProcessedExp.quality > 0,1,NULL)) AS Ncambad"; + $query .= " FROM rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) JOIN camProcessedExp USING (cam_id) LEFT JOIN fakeRun USING (cam_id) LEFT JOIN warpRun USING (fake_id)"; + $query .= " WHERE dateobs like '$date%' AND exp_id > $refExpID"; + $query .= " AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%') AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL'"; + $query .= " GROUP BY chunk ORDER BY dateobs) as suba "; + $query .= "LEFT JOIN"; + $query .= " (SELECT subc.chunk, count(if(subc.Nwarpskycellbad < subc.Nwarpskycell,1,NULL)) AS Nwarpgood, count(if(subc.Nwarpskycellbad = subc.Nwarpskycell,1,NULL)) AS Nwarpbad"; + $query .= " FROM "; + $query .= " (SELECT substr(comment, 1, position(' ' in comment)) AS chunk,count(warpSkyfile.quality) AS Nwarpskycell,count(if(warpSkyfile.quality > 0,1,NULL)) AS Nwarpskycellbad"; + $query .= " FROM rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) LEFT JOIN fakeRun USING (cam_id) LEFT JOIN warpRun USING (fake_id) JOIN warpSkyfile USING (warp_id)"; + $query .= " WHERE dateobs like '$date%' AND exp_id > $refExpID"; + $query .= " AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%') AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL'"; + $query .= " GROUP BY exp_name) as subc"; + $query .= " GROUP BY chunk) AS subb "; + $query .= "ON suba.chunk=subb.chunk"; + + my $result = &mysql_select ($query); + + printf "%18s | %11s | %4s | %4s | %7s | %4s | %7s | %4s | %7s |\n", "chunk", "Nobs", "Ncam","Nwrp","Nwrp_pub", "Nwwd", "Nwwd_pub", "Nwsd", "Nwsd_pub"; + while (@row = $result->fetchrow_array()) { + my $Nvis1 = 0; + my $Nvis2 = 0; + my $Nvis3 = 0; + my $Nvis4 = 0; + my $Ncamgood = 0; + my $Ncambad = 0; + my $Nwarpgood = 0; + my $Nwarpbad = 0; + my $NexpWWdiff = 0; + my $Npubwarps = 0; + my $uniwarps = undef; + + my $chunkname = $row[0]; + if($row[1] gt 0) {$Nvis1 = $row[1]}; + if($row[2] gt 0) {$Nvis2 = $row[2]}; + if($row[3] gt 0) {$Nvis3 = $row[3]}; + if($row[4] gt 0) {$Nvis4 = $row[4]}; + if($row[5] gt 0) {$Ncamgood = $row[5]}; + if($row[6] gt 0) {$Ncambad = $row[6]}; + if($row[7] gt 0) {$Nwarpgood = $row[7]}; + if($row[8] gt 0) {$Nwarpbad = $row[8]}; + + #set flags if present + if($Ncambad >= 1) {$badcamflag = 1}; + if($Nwarpbad >= 1) {$badwarpflag = 1}; + + #Find the total published number of unique warps for this chunk + #my $query0 = " SELECT count(DISTINCT warpRun.warp_id) FROM "; + #$query0 .= " diffInputSkyfile JOIN warpRun ON (warp1=warp_id OR warp2=warp_id) JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id) JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id) JOIN publishRun ON (diffInputSkyfile.diff_id = stage_id)"; + #$query0 .= " WHERE rawExp.dateobs LIKE '$date%' AND exp_id > $refExpID AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%')"; + #$query0 .= " AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL' AND substr(comment, 1, position(' ' in comment)) LIKE '$chunkname%' group by warpRun.warp_id"; + #my $result0 = &mysql_select ($query0); + #while (@row = $result0->fetchrow_array()) {$Npubwarps = $row[0];} + + + #Find the expected number of diffs for this chunk + my $query1 = "SELECT suba.chunk, SUM(IF(suba.Nvisits = 2,1,NULL)) as totvis2, SUM(IF(suba.Nvisits = 3 OR suba.Nvisits = 4,2,NULL)) as totvis34 FROM"; + $query1 .= " (SELECT substr(comment, 1, position(' ' in comment)) AS chunk,count(distinct(comment)) AS Nvisits FROM"; + $query1 .= " rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) WHERE dateobs like '$date%'"; + $query1 .= " AND exp_id > $refExpID AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%') AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL'"; + $query1 .= " AND substr(comment, 1, position(' ' in comment)) LIKE '$chunkname%' group by object) as suba group by chunk;"; + my $result1 = &mysql_select ($query1); + while (@row = $result1->fetchrow_array()) {$NexpWWdiff = $row[1] + $row[2];} + + #find the unique diff_ids for each chunk, to be matched to the diffRun catalog + my $query2 = " SELECT diff_id,warp1,stack1,warp2,stack2 FROM "; + $query2 .= " diffInputSkyfile JOIN warpRun ON (warp1=warp_id OR warp2=warp_id) JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id) JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id)"; + $query2 .= " WHERE rawExp.dateobs LIKE '$date%' AND exp_id > $refExpID AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%')"; + $query2 .= " AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL' AND substr(comment, 1, position(' ' in comment)) LIKE '$chunkname%' GROUP By diff_id"; + my $result2 = &mysql_select ($query2); + + my $NWWdiffgood = 0; + my $NWWdiffbad = 0; + my $NWWdiffpub = 0; + + my $NWSdiffgood = 0; + my $NWSdiffbad = 0; + my $NWSdiffpub = 0; + my %wrpcnt = (); + + while (@row2 = $result2->fetchrow_array()) { + #distinguish between WW and WS diffs based on stack2 + if ($row2[4] == 0) { + #find the total number of skycell and the number of skycell with a bad quality flag as well as the full publish state + my $query3 = " SELECT count(diffSkyfile.quality) AS Ndiff,count(if(diffSkyfile.quality > 0,1,NULL)) AS Ndiffbad,count(if(publishRun.state LIKE 'full',1,NULL)) AS Npub FROM "; + $query3 .= " diffRun JOIN diffSkyfile USING (diff_id) LEFT JOIN publishRun ON (diffRun.diff_id = stage_id)"; + $query3 .= " WHERE diff_id='$row2[0]' GROUP BY diffRun.diff_id"; + my $result3 = &mysql_select ($query3); + while (@row3 = $result3->fetchrow_array()) { + #if all skycells have bad quality, this is a bad diff. If all the skycells are in a full state in publishRun, it is fully published + if ($row3[1]<$row3[0]) {$NWWdiffgood ++;} + if ($row3[1]==$row3[0]) {$NWWdiffbad ++;} + if ($row3[2]==$row3[0]) {$NWWdiffpub ++;} + + #if this wwdiff is published, record its corresponding warp_ids to see how many unique ones there are + if ($row3[2]==$row3[0]) {$wrpcnt{$row2[1]}++;} # record the presence of warp1 + if ($row3[2]==$row3[0]) {$wrpcnt{$row2[3]}++;} # record the presence of warp2 + } + } + + if ($row2[4] > 0) { + #find the total number of skycell and the number of skycell with a bad quality flag as well as the full publish state + my $query3 = " SELECT count(diffSkyfile.quality) AS Ndiff,count(if(diffSkyfile.quality > 0,1,NULL)) AS Ndiffbad,count(if(publishRun.state LIKE 'full',1,NULL)) AS Npub FROM "; + $query3 .= " diffRun JOIN diffSkyfile USING (diff_id) LEFT JOIN publishRun ON (diffRun.diff_id = stage_id)"; + $query3 .= " WHERE diff_id='$row2[0]' GROUP BY diffRun.diff_id"; + my $result3 = &mysql_select ($query3); + while (@row3 = $result3->fetchrow_array()) { + #if all skycells have bad quality, this is a bad diff. If all the skycells are in a full state in publishRun, it is fully published + if ($row3[1]<$row3[0]) {$NWSdiffgood ++;} + if ($row3[1]==$row3[0]) {$NWSdiffbad ++;} + if ($row3[2]==$row3[0]) {$NWSdiffpub ++;} + } + } + } + #pull out the unique warp_ids + $Npubwarps = keys %wrpcnt; + + #check for bad diffs + if(($NWWdiffbad >= 1) or ($NWSdiffbad >= 1)) {$baddiffflag = 1;} + + if ($Nvis1 ne $Nvis4) { + if ($NWWdiffpub ne $NexpWWdiff) {printf "%18s | %2s%1s%2s%1s%2s%1s%2s | %2s%1s%1s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %20s\n", $chunkname, $Nvis1, "/",$Nvis2, "/",$Nvis3, "/",$Nvis4,$Ncamgood, "/",$Ncambad,$Nwarpgood, "/",$Nwarpbad,$Npubwarps,$NWWdiffgood, "/",$NWWdiffbad,$NWWdiffpub,$NWSdiffgood, "/",$NWSdiffbad,$NWSdiffpub, "chunk incomplete, not done";} + if ($NWWdiffpub eq $NexpWWdiff) {printf "%18s | %2s%1s%2s%1s%2s%1s%2s | %2s%1s%1s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %20s\n", $chunkname, $Nvis1, "/",$Nvis2, "/",$Nvis3, "/",$Nvis4,$Ncamgood, "/",$Ncambad,$Nwarpgood, "/",$Nwarpbad,$Npubwarps,$NWWdiffgood, "/",$NWWdiffbad,$NWWdiffpub,$NWSdiffgood, "/",$NWSdiffbad,$NWSdiffpub, "chunk incomplete, done";} + } + if ($Nvis1 eq $Nvis4) { + if ($NWWdiffpub ne $NexpWWdiff) {printf "%18s | %2s%1s%2s%1s%2s%1s%2s | %2s%1s%1s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %20s\n", $chunkname, $Nvis1, "/",$Nvis2, "/",$Nvis3, "/",$Nvis4,$Ncamgood, "/",$Ncambad,$Nwarpgood, "/",$Nwarpbad,$Npubwarps,$NWWdiffgood, "/",$NWWdiffbad,$NWWdiffpub,$NWSdiffgood, "/",$NWSdiffbad,$NWSdiffpub, "chunk complete, not done";} + if ($NWWdiffpub eq $NexpWWdiff) {printf "%18s | %2s%1s%2s%1s%2s%1s%2s | %2s%1s%1s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %2s%1s%1s | %8s | %20s\n", $chunkname, $Nvis1, "/",$Nvis2, "/",$Nvis3, "/",$Nvis4,$Ncamgood, "/",$Ncambad,$Nwarpgood, "/",$Nwarpbad,$Npubwarps,$NWWdiffgood, "/",$NWWdiffbad,$NWWdiffpub,$NWSdiffgood, "/",$NWSdiffbad,$NWSdiffpub, "chunk complete, done";} + } + } + + print "\n"; + + #----------------------------------------- + #list bad quality cam exposures + if ($badcamflag != 0) { + my $query = "SELECT exp_name,cam_id, camProcessedExp.quality, camProcessedExp.sigma_ra, camProcessedExp.sigma_dec, comment"; + $query .= " FROM rawExp"; + $query .= " JOIN chipRun USING (exp_id)"; + $query .= " JOIN camRun USING (chip_id)"; + $query .= " JOIN camProcessedExp USING (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%') AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL'"; + $query .= " AND (camProcessedExp.quality > 0 OR camProcessedExp.sigma_ra > 5 OR camProcessedExp.sigma_dec > 5)"; + $query .= " ORDER BY comment"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + + while (@row = $result->fetchrow_array()) { + if ($doHeader) { + print "Bad quality camRun exposures:\n"; + printf "%11s | %7s | %7s | %9s | %9s | %15s\n", "exp_name","cam_id", "quality", "sigma_ra", "sigma_dec", "comment"; + $doHeader = 0; + } + printf "%11s | %7s | %7d | %9s | %9s | %15s\n", $row[0], $row[1], $row[2], $row[3], $row[4], $row[5]; + } + if (!$doHeader) { print "\n"; } + } + + #----------------------------------------- + #list bad quality warp exposures + if ($badwarpflag != 0) { + $query = "SELECT exp_name,warp_id,count(warpSkyfile.quality) AS Nwarpskycell,count(if(warpSkyfile.quality > 0,1,NULL)) AS Nwarpskycellbad, comment"; + $query .= " FROM rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) LEFT JOIN fakeRun USING (cam_id) LEFT JOIN warpRun USING (fake_id) JOIN warpSkyfile USING (warp_id)"; + $query .= " WHERE dateobs like '$date%' AND exp_id > $refExpID"; + $query .= " AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%') AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL'"; + $query .= " GROUP BY exp_name ORDER BY comment"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + + while (@row = $result->fetchrow_array()) { + if ($row[2] == $row[3]) { + if ($doHeader) { + print "Bad quality warpRun exposures:\n"; + printf "%11s | %7s | %15s\n", "exp_name", "warp_id", "comment"; + $doHeader = 0; + } + printf "%11s | %7d | %15s \n", $row[0], $row[1], $row[4]; + } + } + if (!$doHeader) { print "\n"; } + } + + #----------------------------------------- + #list bad quality diff exposures + if ($baddiffflag != 0) { + my $query = " SELECT diff_id,warp1,stack1,warp2,stack2,exp_name,comment FROM "; + $query .= " diffInputSkyfile JOIN warpRun ON (warp1=warp_id OR warp2=warp_id) JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id) JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id)"; + $query .= " WHERE rawExp.dateobs LIKE '$date%' AND exp_id > $refExpID AND (camRun.label LIKE '%SS%' OR camRun.label LIKE '%EU%' OR camRun.label LIKE '%Bright.%') AND obs_mode NOT LIKE 'ENGINEERING' AND obs_mode NOT LIKE 'MANUAL'"; + $query .= " GROUP By diff_id"; + my $result = &mysql_select ($query); + + $doHeader = 1; + + while (@row = $result->fetchrow_array()) { + if ($doHeader) { + print "Bad quality diffRun exposures:\n"; + printf "%11s | %7s | %7s | %7s | %7s | %7s | %15s\n", "exp_name", "diff_id", "warp1", "stack1", "warp2", "stack2", "comment"; + $doHeader = 0; + } + + #distinguish between WW and WS diffs based on stack2 + if ($row[4] == 0) { + #find the total number of skycell and the number of skycell with a bad quality flag as well as the full publish state + my $query3 = " SELECT count(diffSkyfile.quality) AS Ndiff,count(if(diffSkyfile.quality > 0,1,NULL)) AS Ndiffbad,count(if(publishRun.state LIKE 'full',1,NULL)) AS Npub FROM "; + $query3 .= " diffRun JOIN diffSkyfile USING (diff_id) LEFT JOIN publishRun ON (diffRun.diff_id = stage_id)"; + $query3 .= " WHERE diff_id='$row[0]' GROUP BY diffRun.diff_id"; + my $result3 = &mysql_select ($query3); + while (@row3 = $result3->fetchrow_array()) { + #if all skycells have bad quality, this is a bad diff. If all the skycells are in a full state in publishRun, it is fully published + if ($row3[1]==$row3[0]) {printf "%11s | %7d | %7d | %7d | %7d | %7d | %15s \n", $row[5], $row[0], $row[1], $row[2], $row[3], $row[4], $row[6];} + } + } + + if ($row[4] > 0) { + #find the total number of skycell and the number of skycell with a bad quality flag as well as the full publish state + my $query3 = " SELECT count(diffSkyfile.quality) AS Ndiff,count(if(diffSkyfile.quality > 0,1,NULL)) AS Ndiffbad,count(if(publishRun.state LIKE 'full',1,NULL)) AS Npub FROM "; + $query3 .= " diffRun JOIN diffSkyfile USING (diff_id) LEFT JOIN publishRun ON (diffRun.diff_id = stage_id)"; + $query3 .= " WHERE diff_id='$row[0]' GROUP BY diffRun.diff_id"; + my $result3 = &mysql_select ($query3); + while (@row3 = $result3->fetchrow_array()) { + #if all skycells have bad quality, this is a bad diff. If all the skycells are in a full state in publishRun, it is fully published + if ($row3[1]==$row3[0]) {printf "%11s | %7d | %7d | %7d | %7d | %7d | %15s \n", $row[5], $row[0], $row[1], $row[2], $row[3], $row[4], $row[6];} + } + } + } + if (!$doHeader) { print "\n"; } + } +} + + +print "\n\n\n"; +print "--- IPP Report for $dbname : $date ---\n\n"; + + + +### testing the diff grouping -- this does not work for the Euclid data taken 2018.07.29 because the OBJECT +### field is missing +if (0) { + print "Expected number of WWdiffs excluding camRuns with bad quality:\n"; + print "NOTE: multiple exposures with same comment string (xyz visit a) are treated as 1 exposure\n"; + + # my $query = "SELECT Nvisit, count(*) FROM"; + # $query .= " ("; + my $query = " SELECT object, filter, chunk, count(*) as Nvisit FROM"; + $query .= " ("; + $query .= "SELECT object, filter, comment, 'S', substr(comment, 1, position(' ' in comment)) as chunk, 'E'"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (obs_mode like '%SS%' or obs_mode like 'BRIGHT')"; + $query .= " AND rawExp.comment like '%visit%'"; + $query .= " AND (camProcessedExp.quality IS NULL or camProcessedExp.quality = 0)"; +# $query .= " GROUP BY comment, filter, substr(comment, 1, position(' ' in comment))"; + $query .= " ) AS tableChunks GROUP BY object, filter, chunk"; +# $query .= " ) AS tableVisits GROUP BY Nvisit"; + + my $result = &mysql_select ($query); + &mysql_dump_result ($result); + die; + + $diffExpect = 0; + while (@row = $result->fetchrow_array()) { + # printf "%8s %15s : ", $row[0], $row[1]; # c, count(*) + if ($row[0] == 1) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 1 visit, no WWdiffs\n", $row[1], $verb; + } elsif ($row[0] == 2) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 2 visits, expect $row[1] WWdiff(s)\n", $row[1], $verb; + $diffExpect += $row[1]; + } elsif ($row[0] == 3) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 3 visits, expect %d WWdiffs (2 per tuple)\n", $row[1], $verb, 2 * $row[1]; + $diffExpect += $row[1]*2; + } elsif ($row[0] == 4) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 4 visits, expect %d WWdiffs (2 per tuple)\n", $row[1], $verb, 2 * $row[1]; + $diffExpect += $row[1]*2; + } else { + # print "I don't understand, there are more visits than I expect\n"; + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + if ($row[0] % 2) { $Ndiffs = int($row[0] / 2) + 1; } else { $Ndiffs = int($row[0] / 2); } + printf "%3d %-11s %d visits, expect %d WWdiffs (2 per quad)\n", $row[1], $verb, $row[0], $Ndiffs; + $diffExpect += $Ndiffs; + } + } + print "\n"; + print " * $diffExpect diffRuns expected *\n"; + if ($verbose) { print "\n"; } + + die; +} +###################### + +# check the status of summit exposures: +if (1) { + if ($verbose) { print "Exposures at summit:\n"; } + + $summitSkipped = 0; + $summitPending = 0; + + my $query = "SELECT exp_type, fault, state, count(*)"; + $query .= " FROM summitExp"; + $query .= " LEFT JOIN pzDownloadExp USING (summit_id)"; + $query .= " WHERE dateobs like '$date%'"; + $query .= " AND (state != 'drop' or state IS NULL)"; + $query .= " AND fault != 1042"; + $query .= " GROUP BY exp_type, fault, state"; + + my $result = &mysql_select ($query); + + if ($verbose) { printf "%8s %15s %6s %4s\n", "exp_type", "fault", "state", "N(exp)"; } + while (@row = $result->fetchrow_array()) { + if ($verbose) { printf "%8s %15s %6s %4d\n", $row[0], $row[1], $row[2], $row[3]; } + if ($row[2] eq "run") { + $summitPending += $row[3]; + } + if ($row[2] eq "") { + $summitSkipped += $row[3]; + } + } + if ($summitSkipped || $summitPending) { + print "*** WARNING: $summitSkipped skipped rawExp, $summitPending incomplete rawExp ***\n\n"; + + my $query = "SELECT summitExp.exp_name,exp_type, fault, state"; + $query .= " FROM summitExp"; + $query .= " LEFT JOIN pzDownloadExp USING (summit_id)"; + $query .= " WHERE dateobs like '$date%'"; + $query .= " AND (state like 'new' or state IS NULL)"; + $query .= " AND fault != 1042"; + + my $result = &mysql_select ($query); + printf "%12s %8s %15s %6s\n", "exp_name", "exp_type", "fault", "state"; + while (@row = $result->fetchrow_array()) { + if ($row[3] eq "") { $row[3] = "NULL"; } + printf "%12s %8s %15s %6s\n", $row[0], $row[1], $row[2], $row[3]; + } + } + print "\n"; +} + +# check for exposures not sent to chip: +if ($verbose2) { + + my $query = "SELECT summitExp.exp_name, exp_type, fault, state"; + $query .= " FROM summitExp"; + $query .= " LEFT JOIN pzDownloadExp USING (summit_id)"; + $query .= " WHERE dateobs like '$date%'"; +# $query .= " AND (state != 'drop' or state IS NULL)"; + $query .= " AND fault != 1042"; + $query .= " AND state IS NULL"; + + print "$query\n"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + while (@row = $result->fetchrow_array()) { + if ($doHeader) { + print "OBJECT Exposures NOT sent to chipRun:\n"; + printf "%11s %15s %14s %14s\n", "exp_name", "exp_type", "fault", "state"; + $doHeader = 0; + } + printf "%11s %15s %14s %14s\n", $row[0], $row[1], $row[2], $row[3]; + } + if (! $doHeader) { print "\n"; } +} + +# check the status of raw exposures: +if (1) { + if ($verbose or $report) { print "Exposures in rawExp:\n"; } + + $expSkipped = 0; + $expPending = 0; + + my $query = "SELECT exp_type, obs_mode, state, count(*)"; + $query .= " FROM rawExp"; + $query .= " WHERE dateobs like '$date%'"; + $query .= " AND exp_id > $refExpID"; # REF +# $query .= " AND exp_type = 'OBJECT'"; + $query .= " GROUP BY exp_type, obs_mode, state"; + $query .= " ORDER BY exp_type, obs_mode"; + + my $result = &mysql_select ($query); + + if ($verbose or $report) { printf "%8s %15s %6s %4s\n", "exp_type", "obs_mode", "state", "N(exp)"; } + while (@row = $result->fetchrow_array()) { + if ($verbose or $report) { printf "%8s %15s %6s %4d\n", $row[0], $row[1], $row[2], $row[3]; } + if ($row[2] eq "new") { + $expPending += $row[3]; + } + if ($row[2] eq "") { + $expSkipped += $row[3]; + } + } + if ($expSkipped || $expPending) { print "*** WARNING: $expSkipped skipped rawExp, $expPending incomplete rawExp ***\n\n"; } else { if ($verbose) { print "\n"; }} +} + +# check the status of chip runs: +if (1) { + if ($verbose) { print "Exposures in chipRun (OBJECT, obs_mode not like ENGINEERING, not NULL):\n"; } # the obs_mode not NULL is implicit given the obs_mode not like ENGINEERING + + $chipPending = 0; + $chipSkipped = 0; + + my $query = "SELECT exp_type, obs_mode, chipRun.state, count(*)"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " GROUP BY obs_mode, chipRun.state"; + + my $result = &mysql_select ($query); + + if ($verbose) { printf "%8s %15s %6s %4s", "exp_type", "obs_mode", "state", "N(exp)\n"; } + while (@row = $result->fetchrow_array()) { + if ($verbose) { printf "%8s %15s %6s %4d\n", $row[0], $row[1], $row[2], $row[3]; } + if ($row[2] eq "new") { + $chipPending += $row[3]; + } + if ($row[2] eq "") { + $chipSkipped += $row[3]; + } + } + if ($chipPending || $chipSkipped) { print "*** WARNING: $chipSkipped skipped chipRun, $chipPending incomplete chipRun ***\n\n"; } else { if ($verbose) { print "\n"; }} +} + +# check the status of camera runs: +$camPending = 0; +$camSkipped = 0; +{ + if ($verbose) { print "Exposures in camRun (OBJECT, not ENGINEERING)...\n"; } + + # my $result = &mysql_select (""); + my $query = "SELECT exp_type, obs_mode, camRun.state, camProcessedExp.fault, camProcessedExp.quality, count(*)"; + $query .= " FROM rawExp join chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " GROUP BY obs_mode, camRun.state, camProcessedExp.fault, camProcessedExp.quality"; + + my $result = &mysql_select ($query); + + if ($verbose) { printf "%8s %15s %6s %4s | %5s %5s\n", "exp_type", "obs_mode", "state", "N(exp)", "fault", "quality"; } + while (@row = $result->fetchrow_array()) { + if ($verbose) { printf "%8s %15s %6s %4d | %5d %5d\n", $row[0], $row[1], $row[2], $row[5], $row[3], $row[4]; } # exp_type, obs_mode, camRun.state, camProcessedExp.fault, camProcessedExp.quality, count(*) + if ($row[2] eq "new") { + $camPending += $row[5]; + } + if ($row[2] eq "") { + $camSkipped += $row[5]; + } + } + if ($camSkipped || $camPending) { print "*** WARNING: $camSkipped skipped camRuns, $camPending pending camRuns ***\n\n"; } else { if ($verbose) { print "\n"; }} +} + +# check the status of fake runs: +{ + if ($verbose) { print "Exposures in fakeRun:\n"; } + + $fakePending = 0; + $fakeSkipped = 0; + + my $query = "SELECT exp_type, obs_mode, fakeRun.state, count(*)"; + $query .= " FROM rawExp"; + $query .= " JOIN chipRun using (exp_id)"; + $query .= " JOIN camRun using (chip_id)"; + $query .= " JOIN camProcessedExp using (cam_id)"; + $query .= " LEFT JOIN fakeRun using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND (camProcessedExp.quality is null or camProcessedExp.quality = 0)"; + $query .= " GROUP BY obs_mode, fakeRun.state"; + + my $result = &mysql_select ($query); + + if ($verbose) { printf "%8s %15s %6s %4s\n", "exp_type", "obs_mode", "state", "N(exp)"; } + while (@row = $result->fetchrow_array()) { + if ($verbose) { printf "%8s %15s %6s %4d\n", $row[0], $row[1], $row[2], $row[3]; } # exp_type, obs_mode, fakeRun.state, count(*) + if ($row[2] eq "new") { + $fakePending += $row[3]; + } + if ($row[2] eq "") { + $fakeSkipped += $row[3]; + } + } + if ($fakeSkipped || $fakePending) { print "$fakeSkipped skipped fakeRuns, $fakePending pending fakeRuns\n\n"; } else { if ($verbose) { print "\n"; }} +} + +# check the status of warp runs: +{ + if ($verbose) { print "Exposures in warpRuns:\n"; } + + $warpPending = 0; + $warpSkipped = 0; + + # my $result = &mysql_select (""); + my $query = "SELECT exp_type, obs_mode, warpRun.state, count(*)"; + $query .= " FROM rawExp"; + $query .= " JOIN chipRun using (exp_id)"; + $query .= " JOIN camRun using (chip_id)"; + $query .= " JOIN camProcessedExp using (cam_id)"; + $query .= " JOIN fakeRun using (cam_id)"; + $query .= " LEFT JOIN warpRun using (fake_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND (camProcessedExp.quality IS NULL OR camProcessedExp.quality = 0)"; + $query .= " GROUP BY obs_mode, warpRun.state"; + + my $result = &mysql_select ($query); + + if ($verbose) { printf "%8s %15s %6s %4s\n", "exp_type", "obs_mode", "state", "N(exp)"; } + while (@row = $result->fetchrow_array()) { + if ($verbose) { printf "%8s %15s %6s %4d\n", $row[0], $row[1], $row[2], $row[3]; } # exp_type, obs_mode, warpRun.state, count(*) + if ($row[2] eq "new") { + $warpPending += $row[3]; + } + if ($row[2] eq "") { + $warpSkipped += $row[3]; + } + } + if ($warpSkipped || $warpPending) { print "$warpSkipped skipped warpRuns, $warpPending pending warpRuns\n\n"; } else { if ($verbose) { print "\n"; }} +} + +# count the number of exposures per chunk, determine expected diffRuns: +{ + if ($report) { + print "\n"; + } else { + print "Expected number of WWdiffs excluding camRuns with bad quality:\n"; + print "NOTE: multiple exposures with same comment string (xyz visit a) are treated as 1 exposure\n"; + } + + # my $result = &mysql_select (""); + my $query = "SELECT Nvisit, count(*) FROM"; + $query .= " ("; + $query .= " SELECT object, filter, chunk, count(*) as Nvisit FROM"; + $query .= " ("; + $query .= " SELECT object, filter, substr(comment, 1, position(' ' in comment)) as chunk"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND rawExp.comment like '%visit%'"; + $query .= " AND (camProcessedExp.quality IS NULL or camProcessedExp.quality = 0)"; + $query .= " GROUP BY comment, filter, substr(comment, 1, position(' ' in comment))"; + $query .= " ) AS tableChunks GROUP BY object, filter, chunk"; + $query .= " ) AS tableVisits GROUP BY Nvisit"; + + my $result = &mysql_select ($query); + + $diffExpect = 0; + while (@row = $result->fetchrow_array()) { + printf "%8s %15s : ", $row[0], $row[1]; # c, count(*) + if ($row[0] == 1) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 1 visit, no WWdiffs\n", $row[1], $verb; + } elsif ($row[0] == 2) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 2 visits, expect $row[1] WWdiff(s)\n", $row[1], $verb; + $diffExpect += $row[1]; + } elsif ($row[0] == 3) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 3 visits, expect %d WWdiffs (2 per tuple)\n", $row[1], $verb, 2 * $row[1]; + $diffExpect += $row[1]*2; + } elsif ($row[0] == 4) { + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + printf "%3d %-11s 4 visits, expect %d WWdiffs (2 per tuple)\n", $row[1], $verb, 2 * $row[1]; + $diffExpect += $row[1]*2; + } else { + # print "I don't understand, there are more visits than I expect\n"; + if ($row[1] == 1) { $verb = "tuple has"; } else { $verb = "tuples have"; } + if ($row[0] % 2) { $Ndiffs = int($row[0] / 2) + 1; } else { $Ndiffs = int($row[0] / 2); } + printf "%3d %-11s %d visits, expect %d WWdiffs (2 per quad)\n", $row[1], $verb, $row[0], $Ndiffs; + $diffExpect += $Ndiffs; + } + } + print "\n"; + print " * $diffExpect diffRuns expected *\n"; + if ($verbose) { print "\n"; } + + + +} + +# List chunks with duplicate visits +{ + # my $result = &mysql_select (""); +# my $query = "SELECT Nvisit, count(*) FROM"; +# $query .= " ("; + $query .= " SELECT object, filter, chunk, Nexp_in_chunk FROM"; + $query .= " ("; + $query .= " SELECT object, filter, substr(comment, 1, position(' ' in comment)) as chunk, count(*) as Nexp_in_chunk"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND rawExp.comment like '%visit%'"; + $query .= " AND (camProcessedExp.quality IS NULL or camProcessedExp.quality = 0)"; + $query .= " GROUP BY comment, filter, substr(comment, 1, position(' ' in comment))"; + $query .= " ) AS tableChunks where (Nexp_in_chunk > 1)"; +# $query .= " ) AS tableVisits GROUP BY Nvisit"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + while (@row = $result->fetchrow_array()) { + if ($doHeader) { + print "chunks with duplicate visits:\n"; + printf "%11s %15s %14s %5s\n", "object", "filter", "chunk", "Nexp in chunk"; + $doHeader = 0; + } + printf "%11s %15s %14s %5s\n", $row[0], $row[1], $row[2], $row[3]; + } + if (! $doHeader) { print "\n"; } +} + +# List exposures which may be used for WWdiffs +if (0) { + print "List exposures for WWdiffs excluding camRuns with bad quality:\n"; + + # my $result = &mysql_select (""); + my $query = ""; + $query .= " SELECT 'EXAMPLE', exp_name, object, filter, substr(comment, 1, position(' ' in comment)) as chunk"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND rawExp.comment like '%visit%'"; + $query .= " AND (camProcessedExp.quality IS NULL or camProcessedExp.quality = 0)"; + + my $result = &mysql_select ($query); + &mysql_dump_result ($result); +} + +# check the status of diff runs: +{ + if ($verbose) { print "diff processing status (not WS):\n"; } + + $diffDone = 0; + + my $query = "SELECT label, state, count(*)"; + $query .= " FROM diffRun"; + $query .= " WHERE data_group like '%$dataGroupDate'"; + $query .= " AND label NOT LIKE '%WS.nigh%'"; + $query .= " AND label NOT LIKE 'goto_cleaned'"; + $query .= " GROUP BY label, state"; + + my $result = &mysql_select ($query); + + if ($verbose) { printf "%20s %6s | %8s\n", "label", "state", "N(diffs)"; } + while (@row = $result->fetchrow_array()) { + if ($verbose) { printf "%20s %6s | %8d\n", $row[0], $row[1], $row[2]; } # label, state, count + if (($row[1] ne "new") && ($row[1] ne "")) { + $diffDone += $row[2]; + } + } + if ($verbose) { print "\n"; } + if ($diffDone != $diffExpect) { + print "*** WARNING: Expect $diffExpect diffRuns, complete $diffDone diffRuns: inconsistent ***\n"; + + if ($verbose) { + print "Published diffs split by Nvisit :\n"; + printf "%8s %10s\n", "Nvisit", "N_pubdiff"; + + my $query = "SELECT Nvisit, SUM(Ndiffs) FROM "; + $query .= " (SELECT object, filter, chunk, count(*) as Nvisit,count(DISTINCT diff_id) as Ndiffs FROM"; + $query .= " (SELECT expall.object, expall.filter, expall.chunk as chunk, expall.exp_name,exppub.diff_id from"; + $query .= " ("; + $query .= " SELECT object, filter,exp_name, substr(comment, 1, position(' ' in comment)) as chunk, dateobs, warp_id"; + $query .= " FROM rawExp"; + $query .= " JOIN chipRun using (exp_id)"; + $query .= " JOIN camRun using (chip_id)"; + $query .= " JOIN camProcessedExp using (cam_id)"; + $query .= " JOIN fakeRun using (cam_id)"; + $query .= " JOIN warpRun using (fake_id)"; + $query .= " WHERE dateobs like '$date%'"; + $query .= " AND exp_id > $refExpID"; + $query .= " AND (camProcessedExp.quality = 0)"; + $query .= " AND (comment NOT LIKE '%twilight%')"; + $query .= " ) AS expall"; + $query .= " JOIN"; + $query .= " (SELECT * FROM ("; + $query .= " (SELECT exp_name, warpRun.warp_id, diffRun.diff_id, publishRun.state as pubstate FROM"; + $query .= " diffRun JOIN diffInputSkyfile USING (diff_id) JOIN publishRun ON (diff_id = stage_id)"; + $query .= " JOIN warpRun ON (warp1=warp_id) JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id)"; + $query .= " JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id)"; + $query .= " WHERE rawExp.dateobs like '$date%' AND diffRun.label NOT LIKE '%WS.nigh%' AND diffRun.label NOT LIKE 'goto_cleaned'"; + $query .= " AND stack2 IS NULL AND diffRun.data_group LIKE '%.$dataGroupDate')"; + $query .= " UNION"; + $query .= " (SELECT exp_name, warpRun.warp_id, diffRun.diff_id, publishRun.state as pubstate FROM"; + $query .= " diffRun JOIN diffInputSkyfile USING (diff_id) JOIN publishRun ON (diff_id = stage_id)"; + $query .= " JOIN warpRun ON (warp2=warp_id) JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id)"; + $query .= " JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id)"; + $query .= " WHERE rawExp.dateobs like '$date%' AND diffRun.label NOT LIKE '%WS.nigh%' AND diffRun.label NOT LIKE 'goto_cleaned'"; + $query .= " AND stack2 IS NULL AND diffRun.data_group LIKE '%.$dataGroupDate')"; + $query .= " ) AS diffgather"; + $query .= " GROUP BY diffgather.exp_name)"; + $query .= " AS exppub"; + $query .= " ON expall.exp_name = exppub.exp_name"; + $query .= " ) AS pubdiffgather GROUP BY object, filter, chunk"; + $query .= " ) AS tableVisits GROUP BY Nvisit"; + + my $result = &mysql_select ($query); + while (@row = $result->fetchrow_array()) { + printf "%8s %10s\n", $row[0], $row[1]; + } + + #------------------------------------------------------------- + print "\n"; + print "Listing objects with 1< Nvisits < 4:\n"; + printf "| %12s | %8s | %19s | %8s |\n", "object", "filter", "chunk", "Nvisit"; + + my $query = "SELECT * FROM"; + $query .= " ("; + $query .= " SELECT object, filter, chunk, count(*) as Nvisit FROM"; + $query .= " ("; + $query .= " SELECT object, filter, substr(comment, 1, position(' ' in comment)) as chunk"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND rawExp.comment like '%visit%'"; + $query .= " AND (camProcessedExp.quality IS NULL or camProcessedExp.quality = 0)"; + $query .= " GROUP BY comment, filter, substr(comment, 1, position(' ' in comment))"; + $query .= " ) AS tableChunks GROUP BY object, filter, chunk"; + $query .= " ) AS tableVisits WHERE Nvisit > 1 AND Nvisit < 4 ORDER BY chunk,Nvisit "; + my $result = &mysql_select ($query); + + while (@row = $result->fetchrow_array()) { + printf "| %12s | %8s | %19s | %8s |\n", $row[0], $row[1], $row[2], $row[3]; + } + print "\n"; + } + + } else { + if (not $report) { print " * $diffDone of $diffExpect diffRuns completed *\n"; } + } +} + +# count diffRuns to be published: +{ + my $query = "SELECT count(*) FROM"; + $query .= " ("; + $query .= " SELECT label, state, count(*)"; + $query .= " FROM diffRun"; + $query .= " LEFT JOIN diffSkyfile using (diff_id)"; + $query .= " WHERE data_group LIKE '%$dataGroupDate%'"; + $query .= " AND label NOT LIKE '%WS.nigh%'"; + $query .= " AND label NOT LIKE 'goto_cleaned'"; + $query .= " AND (quality IS NULL OR quality = 0)"; + $query .= " GROUP BY label, state, diff_id"; + $query .= " ) as tableDiffs"; + + my $result = &mysql_select ($query); + + @row = $result->fetchrow_array(); + if (not $report) { printf " * %d diffRuns can be published * (has at least 1 skycell with quality = 0 or quality is NULL)\n", $row[0]; } + if ($verbose) { print "\n"; } + $diffRunsToBePublished = $row[0]; +} + +# check the status of publish runs: +{ + if ($verbose) { print "publishing status (not WS)...\n"; } + + $pubDone = 0; + + my $query = "SELECT diffRun.label, publishRun.state, count(*)"; + $query .= " FROM diffRun"; + $query .= " LEFT JOIN publishRun on (diff_id = stage_id)"; + $query .= " WHERE data_group LIKE '%$dataGroupDate'"; + $query .= " AND diffRun.label NOT LIKE '%WS.nigh%'"; + $query .= " AND diffRun.label NOT LIKE 'goto_cleaned'"; + $query .= " GROUP BY diffRun.label, publishRun.state"; + + my $result = &mysql_select ($query); + + if ($verbose) { printf "%20s %6s | %8s\n", "label", "state", "N(diffs)"; } + while (@row = $result->fetchrow_array()) { + if ($verbose) { printf "%20s %6s | %8d\n", $row[0], $row[1], $row[2]; } # label, state, count + if (($row[1] ne "new") && ($row[1] ne "")) { + $pubDone += $row[2]; + } + } + if ($verbose) { print "\n"; } + if ($pubDone != $diffRunsToBePublished) { + print "*** WARNING: Expect $diffRunsToBePublished diffRuns to be published, only $pubDone pubRuns: inconsistent ***\n\n"; + } else { + print " * $pubDone of $diffRunsToBePublished diffRuns published **\n\n"; + } +} + +# check for exposures not sent to chip: +if ($verbose) { + + my $query = "SELECT exp_name, obs_mode, comment"; + $query .= " FROM rawExp left join chipRun using (exp_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND chip_id is null"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + while (@row = $result->fetchrow_array()) { + if ($doHeader) { + print "OBJECT Exposures NOT sent to chipRun:\n"; + printf "%11s %15s %14s", "exp_name", "obs_mode", "comment\n"; + $doHeader = 0; + } + printf "%11s %15s %14s\n", $row[0], $row[1], $row[2]; + } + if (! $doHeader) { print "\n"; } +} + +# check for chipRuns not sent to camera +if ($camSkipped && $verbose) { + print "chipRuns NOT sent to camRun:\n"; + + my $query = "SELECT exp_name, obs_mode, comment, chipRun.state"; + $query .= " FROM rawExp"; + $query .= " JOIN chipRun USING (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND cam_id IS NULL"; + + my $result = &mysql_select ($query); + + printf "%11s %15s %10s %14s\n", "exp_name", "obs_mode", "chip.state", "comment"; + while (@row = $result->fetchrow_array()) { + printf "%11s %15s %10s %14s\n", $row[0], $row[1], $row[2], $row[3]; + } + print "\n"; +} + +# check for bad quality camera exposurs +if (1) { + my $query = "SELECT exp_name, camProcessedExp.quality, comment"; + $query .= " FROM rawExp"; + $query .= " JOIN chipRun USING (exp_id)"; + $query .= " JOIN camRun USING (chip_id)"; + $query .= " JOIN camProcessedExp USING (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (camProcessedExp.quality > 0)"; + $query .= " ORDER BY comment"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + $NbadCam = 0; + + while (@row = $result->fetchrow_array()) { + if (($verbose or $report) && $doHeader) { + print "Bad quality camRun exposures:\n"; + printf "%11s %7s | %15s\n", "exp_name", "quality", "comment"; + $doHeader = 0; + } + if ($verbose or $report) { printf "%11s %7d | %15s\n", $row[0], $row[1], $row[2]; } else { $NbadCam ++; } + } + if (($verbose or $report) && !$doHeader) { print "\n"; } + if (!($verbose or $report)) { print "$NbadCam bad quality camera exposures\n\n"; } +} + +# check the status of diff runs NOT for Solar System: +if ($verbose or $report) { + # my $result = &mysql_select (""); + my $query = "SELECT * FROM"; + $query .= " ("; + $query .= " SELECT object, filter, chunk, count(*) as Nvisit FROM"; + $query .= " ("; + $query .= " SELECT object, filter, substr(comment, 1, position(' ' in comment)) as chunk"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (obs_mode NOT LIKE '%SS%' AND obs_mode NOT LIKE '%BRIGHT%')"; + $query .= " AND rawExp.comment like '%visit%'"; + $query .= " AND (camProcessedExp.quality IS NULL or camProcessedExp.quality = 0)"; + $query .= " GROUP BY comment, filter, substr(comment, 1, position(' ' in comment))"; + $query .= " ) AS tableChunks GROUP BY object, filter, chunk"; + $query .= " ) AS tableVisits ORDER BY Nvisit, chunk, object"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + while (@row = $result->fetchrow_array()) { + if ($doHeader) { + print "Chunks which should not generate WWdiffs (not Solar System diffs)\n"; + printf "%16s %-8s %20s | %8s\n", "Object", "Filter", "Chunk", "N(visit)"; + $doHeader = 0; + } + printf "%16s %-8s %20s | %4d\n", $row[0], $row[1], $row[2], $row[3]; + } + if (!$doHeader) { print "\n"; } +} + +# check for unpublished solar-system exposures +{ + my $query = "SELECT expall.exp_name, expall.dateobs, expall.comment, expall.warp_id, exppub.diff_id, exppub.pubstate from"; + $query .= " ("; + $query .= " SELECT exp_name, comment, dateobs, warp_id"; + $query .= " FROM rawExp"; + $query .= " JOIN chipRun using (exp_id)"; + $query .= " JOIN camRun using (chip_id)"; + $query .= " JOIN camProcessedExp using (cam_id)"; + $query .= " JOIN fakeRun using (cam_id)"; + $query .= " JOIN warpRun using (fake_id)"; + $query .= " WHERE dateobs like '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND (camProcessedExp.quality = 0)"; + $query .= " AND (comment NOT LIKE '%twilight%')"; + $query .= " ) AS expall"; + $query .= " LEFT JOIN"; + $query .= " (SELECT * FROM ("; + $query .= " (SELECT exp_name, warpRun.warp_id, diffRun.diff_id, publishRun.state as pubstate FROM"; + $query .= " diffRun JOIN diffInputSkyfile USING (diff_id) JOIN publishRun ON (diff_id = stage_id)"; + $query .= " JOIN warpRun ON (warp1=warp_id) JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id)"; + $query .= " JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id)"; + $query .= " WHERE rawExp.dateobs like '$date%' AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND stack2 IS NULL AND diffRun.data_group LIKE '%.$dataGroupDate')"; + $query .= " UNION"; + $query .= " (SELECT exp_name, warpRun.warp_id, diffRun.diff_id, publishRun.state as pubstate FROM"; + $query .= " diffRun JOIN diffInputSkyfile USING (diff_id) JOIN publishRun ON (diff_id = stage_id)"; + $query .= " JOIN warpRun ON (warp2=warp_id) JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id)"; + $query .= " JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id)"; + $query .= " WHERE rawExp.dateobs like '$date%' AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND stack2 IS NULL AND diffRun.data_group LIKE '%.$dataGroupDate')"; + $query .= " ) AS diffgather"; + $query .= " GROUP BY diffgather.exp_name)"; + $query .= " AS exppub"; + $query .= " ON expall.exp_name = exppub.exp_name"; + $query .= " WHERE exppub.exp_name is NULL"; + $query .= " OR exppub.pubstate = 'new'"; + + my $result = &mysql_select ($query); + + $doHeader = 1; + while (@row = $result->fetchrow_array()) { + if ($doHeader) { + print "Unpublished Solar System Exposures WW diffs (obs_mode like %SS% or obs_mode like %BRIGHT%) with good camera quality :\n"; + printf "%12s %12s %12s | %-19s | %-16s\n", "exp_name", "warp_id", "diff_id", "dateobs", "comment"; + $doHeader = 0; + } + if ($row[3] eq "") { $row[3] = "NULL"; } + if ($row[4] eq "") { $row[4] = "NULL"; } + printf "%12s %12s %12s | %-19s | %-16s\n", $row[0], $row[3], $row[4], $row[1], $row[2] + } +} +print "\n\n"; + +# count the number of exposures per chunk, determine expected diffRuns: +if ($verbose2) { + print "Number of exposures for each chunk:\n"; + + # my $result = &mysql_select (""); + my $query = "SELECT object, filter, chunk, count(*) as Nvisit FROM"; + $query .= " ("; + $query .= " SELECT object, filter, substr(comment, 1, position(' ' in comment)) as chunk"; + $query .= " FROM rawExp"; + $query .= " LEFT JOIN chipRun using (exp_id)"; + $query .= " LEFT JOIN camRun using (chip_id)"; + $query .= " LEFT JOIN camProcessedExp using (cam_id)"; + $query .= " WHERE dateobs LIKE '$date%'"; + $query .= " AND exp_id > $refExpID"; #REF + $query .= " AND exp_type = 'OBJECT'"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND rawExp.comment like '%visit%'"; + $query .= " AND (camProcessedExp.quality IS NULL or camProcessedExp.quality = 0)"; + $query .= " GROUP BY comment, filter, substr(comment, 1, position(' ' in comment))"; + $query .= " ) AS tableChunks GROUP BY object, filter, chunk"; + + my $result = &mysql_select ($query); + + printf "%11s %7s %18s %-3s\n", "object", "filter", "chunk", "N(visit)"; + while (@row = $result->fetchrow_array()) { + printf "%11s %7s %18s %3d\n", $row[0], $row[1], $row[2], $row[3]; + } + print "\n"; +} + +# count the number of chunks, and their status: +if ($verbose or $report) { + print "Current status of SS and Euclid chunks:\n"; + + #First find the number of chunks and their names + my $query = "SELECT groupchunk.chunk,groupchunk.Nquad_firstvisit,group4.Nquad_fourvisits FROM"; + $query .= " ("; + $query .= " SELECT dateobs,comment,substr(comment, 1, position(' ' in comment)) AS chunk,count(distinct(comment)) AS Nquad_firstvisit"; + $query .= " FROM rawExp"; + $query .= " WHERE dateobs LIKE '$date%' AND exp_id > $refExpID"; + $query .= " AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%') AND obs_mode NOT LIKE 'ENGINEERING'"; + $query .= " AND comment LIKE '%visit 1%'"; + $query .= " GROUP BY chunk"; + $query .= " ) AS groupchunk"; + $query .= " LEFT JOIN"; + $query .= " ("; + $query .= " SELECT groupobj.chunk,count(*) AS Nquad_fourvisits FROM "; + $query .= " (SELECT substr(comment, 1, position(' ' in comment)) AS chunk,count(distinct(comment)) AS Nvisits"; + $query .= " FROM rawExp"; + $query .= " WHERE dateobs LIKE '$date%' AND exp_id > $refExpID AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query .= " AND obs_mode NOT LIKE 'ENGINEERING' AND comment LIKE '%visit%'"; + $query .= " GROUP BY object, filter, chunk"; + $query .= " ) AS groupobj"; + $query .= " WHERE groupobj.Nvisits = 4 "; + $query .= " GROUP BY groupobj.chunk"; + $query .= " ) AS group4"; + $query .= " on groupchunk.chunk=group4.chunk ORDER BY dateobs"; + + my $result = &mysql_select ($query); + + printf "%18s | %13s | %13s | %14s |\n", "chunk", "Nobs_1stvisit", "Nobs_4visits", "Ndiffs_publish"; + while (@row = $result->fetchrow_array()) { + my $Nfirstvisits = 0; + my $Nfourvisits = 0; + + my $chunkname = $row[0]; + if($row[1] gt 0) {$Nfirstvisits = $row[1]}; + if($row[2] gt 0) {$Nfourvisits = $row[2]}; + + my $query2 .= " SELECT warp_id FROM "; + $query2 .= " warpRun JOIN fakeRun USING (fake_id) JOIN camRun USING (cam_id) JOIN camProcessedExp USING (cam_id) JOIN chipRun USING (chip_id) JOIN rawExp USING (exp_id)"; + $query2 .= " WHERE rawExp.dateobs LIKE '$date%' AND exp_id > $refExpID AND (obs_mode LIKE '%SS%' OR obs_mode LIKE '%BRIGHT%')"; + $query2 .= " AND substr(comment, 1, position(' ' in comment)) LIKE '$chunkname%'"; + my $result2 = &mysql_select ($query2); + + my $Ndiffs = 0; + while (@row2 = $result2->fetchrow_array()) { + my $query3 .= " SELECT diff_id FROM "; + $query3 .= " diffRun JOIN diffInputSkyfile USING (diff_id) JOIN publishRun ON (diff_id = stage_id) JOIN warpRun ON (warp1=warp_id)"; + $query3 .= " WHERE stack2 IS NULL AND publishRun.state LIKE 'full' AND warp_id='$row2[0]' GROUP BY diff_id"; + my $result3 = &mysql_select ($query3); + while (@row3 = $result3->fetchrow_array()) {if ($row3[0] !=0) {$Ndiffs ++;}} + + my $query3 .= " SELECT diff_id FROM "; + $query3 .= " diffRun JOIN diffInputSkyfile USING (diff_id) JOIN publishRun ON (diff_id = stage_id) JOIN warpRun ON (warp2=warp_id)"; + $query3 .= " WHERE stack2 IS NULL AND publishRun.state LIKE 'full' AND warp_id='$row2[0]' GROUP BY diff_id"; + my $result3 = &mysql_select ($query3); + while (@row3 = $result3->fetchrow_array()) {if ($row3[0] !=0) {$Ndiffs ++;}} + } + + if ($Nfirstvisits ne $Nfourvisits) { + if ($Ndiffs ne ($Nfirstvisits*4)) {printf "%18s | %13s | %13s | %10s%4s | %14s\n", $chunkname, $Nfirstvisits, $Nfourvisits, $Ndiffs, "/? ", "chunk not done";} # chunk Nquad_firstvisit Nquad_fourvisits Ndiffs + if ($Ndiffs eq ($Nfirstvisits*4)) {printf "%18s | %13s | %13s | %10s%4s | %14s\n", $chunkname, $Nfirstvisits, $Nfourvisits, $Ndiffs, "/? ", "chunk done";} # chunk Nquad_firstvisit Nquad_fourvisits Ndiffs + } + if ($Nfirstvisits eq $Nfourvisits) { + if ($Ndiffs ne ($Nfirstvisits*4)) {printf "%18s | %13s | %13s | %10s%1s%3s | %14s\n", $chunkname, $Nfirstvisits, $Nfourvisits, $Ndiffs,"/",$Nfirstvisits*4, "chunk not done";} # chunk Nquad_firstvisit Nquad_fourvisits Ndiffs + if ($Ndiffs eq ($Nfirstvisits*4)) {printf "%18s | %13s | %13s | %10s%1s%3s | %14s\n", $chunkname, $Nfirstvisits, $Nfourvisits, $Ndiffs,"/",$Nfirstvisits*4, "chunk done";} # chunk Nquad_firstvisit Nquad_fourvisits Ndiffs + } + } + + print "\n"; +} + + + +exit 0; + +# global dbh? +sub mysql_select { + + my $query = $_[0]; + + my $statement = $dbh->prepare($query); + + $statement->execute(); + + return $statement; +} + +sub mysql_dump_result { + + my $result = $_[0]; + + $Nfields = $result->{NUM_OF_FIELDS}; + + print "Nfields: $Nfields\n"; + + for ($i = 0; $i < $Nfields; $i++) { + printf "Field %d : %s\n", $i, $result->{NAME}->[$i]; + } + + while (@row = $result->fetchrow_array()) { + for ($i = 0; $i < $Nfields; $i++) { + print "$row[$i] "; + } + print "\n"; + } + return; +} + +# example using the dbh prepare, execute, fetch commands: +if (0) { + + my $result = &mysql_select ("SELECT * from rawExp limit 2"); + + &mysql_dump_result ($result); + + exit 1; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/nightly_science.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/nightly_science.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/nightly_science.pl (revision 41105) @@ -0,0 +1,2594 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use DateTime; + +# +# Set up +################################################################################ + +my $missing_tools = 0; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $dqstatstool = can_run('dqstatstool') or (warn "Can't find dqstatstool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $stacktool= can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $magicdstool = can_run('magicdstool') or (warn "Can't find magicdstool" and $missing_tools = 1); +my $dettool = can_run('dettool') or (warn "Can't find dettool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $mkBTpcontrol = can_run('make_burntool_pcontrol.pl') or (warn "Can't find make_burntool_pcontrol.pl" and $missing_tools = 1); +my $moondata = can_run('moondata') or (warn "Can't find moondata" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +## for DB connection, want to use siteConfig DB settings +my $ipprc = PS::IPP::Config->new(); # IPP Configuration +my $siteConfig = $ipprc->{_siteConfig}; + +my $db; +my $debug = 0; +my %metadata_out = (); +$metadata_out{nsState} = 'NIGHTLY_SCIENCE'; +my $loghead; +chomp($loghead = `date`); +print STDERR 'Starting: ' . $loghead . ' ' . $0 . ' ' . (join ' ', @ARGV) . "\n"; + +# Grab options +my ( $date, $datetime, $now, $camera, $dbname, $logfile, $verbose, $manual,$desdiffdt); +my ( $help, $isburning, $force_stack_count, $force_diff_count, $force_registration, $test_mode, $this_target_only, $this_filter_only, $this_mode_only, $check_mode); +my ( $registration_status, $burntool_status, $observing_status, $old_date); +my ( $check_registration, $define_burntool, $queue_burntool, $check_chips, $queue_chips); +my ( $check_stacks, $queue_stacks, $check_sweetspot, $queue_sweetspot, $check_diffs, $queue_diffs, $clean_old); +my ( $check_detrends, $queue_detrends, $check_dqstats, $queue_dqstats); +my ( $confirm_stacks, $check_confirm_stacks ); + +GetOptions( + 'help|h' => \$help, + 'date=s' => \$date, # night to make stacks for + 'camera=s' => \$camera, # camera + 'dbname=s' => \$dbname, # Database name + 'logfile=s' => \$logfile, + 'verbose' => \$verbose, + 'debug' => \$debug, + 'test_mode' => \$test_mode, + 'force_stack_count' => \$force_stack_count, + 'force_diff_count' => \$force_diff_count, + 'force_registration' => \$force_registration, + 'this_target_only=s' => \$this_target_only, + 'this_filter_only=s' => \$this_filter_only, + 'this_mode_only=s' => \$this_mode_only, + 'registraion_status' => \$registration_status, + 'burntool_status' => \$burntool_status, + 'old_date=s' => \$old_date, + 'check_stacks' => \$check_stacks, + 'queue_stacks' => \$queue_stacks, + 'confirm_stacks' => \$confirm_stacks, + 'check_confirm_stacks' => \$check_confirm_stacks, + 'check_diffs' => \$check_diffs, + 'queue_diffs' => \$queue_diffs, + 'check_sweetspot' => \$check_sweetspot, + 'queue_sweetspot' => \$queue_sweetspot, + 'check_detrends' => \$check_detrends, + 'queue_detrends' => \$queue_detrends, + 'check_dqstats' => \$check_dqstats, + 'queue_dqstats' => \$queue_dqstats, + 'clean_old' => \$clean_old, + 'desdiffdt=s' => \$desdiffdt, # TdB20190529delay time for making desperate iddfs on the fly + ) or pod2usage ( 2 ); +pod2usage( -msg => +"USAGE: nightlyscience.pl + Options: + --help This help. + --date YYYY-MM-DD Work on this date (defaults to today GMT). + --camera Default GPC1. + --dbname Default gpc1. + --verbose + --force_stack_count Force the chip/warp counts. + --force_diff_count Force the chip/warp counts. + --force_registration Force registration counts. + --this_target_only Process only a single target. + --this_filter_only Process only a single filter. + --this_mode_only Process only a single clean mode. + --burntool_status Display Nexp Nimfile Nburntooled Nqueued for check_chips. + --desdiffdt Default 3hrs. + Modes: + --check_stacks Confirm that stacks can be built. + --queue_stacks Issue stacktool commands to queue stacks. + --check_diffs Confirm that diffs can be done. + --queue_diffs Issue difftool commands to queue diffs. + --check_sweetspot See if we should queue SweetSpot stacks. + --queue_sweetspot Issue stacktool commands to queue SweetSpot stacks. + --check_detrends Confirm that detrend verify runs can be built. + --queue_detrends Issue dettool commands to queue detrend verify runs. + --check_dqstats Confirm that dqstats tables can be built. + --queue_dqstats Issue dqstatstool commands to queue dqstat tables. + --clean_old Mark old data 'goto_cleanup'.\n", + -exitval => 2, ) if (defined($help)); +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Choose a mode: --check_registration --check_burntool --queue_chips --queue_stacks", + -exitval => 3, + ) unless + defined $check_registration or defined $define_burntool or defined $queue_burntool or + defined $queue_diffs or defined $queue_stacks or $queue_sweetspot or $queue_detrends or $queue_dqstats or + defined $check_diffs or defined $check_stacks or $check_sweetspot or $check_detrends or $check_dqstats or + defined $test_mode or defined $clean_old or defined $check_mode or + defined $confirm_stacks or defined $burntool_status; +pod2usage( + -msg => "Explicitly choose --dbname and --camera", + -exitval => 3, + ) unless (defined($camera) and defined($dbname)); + +# Configurable parameters from our config file. +my %science_config = (); +my %clean_config = (); +my %detrend_config = (); +my %eon_config = (); +my %cleanmods_list = (); +my %macro_config = (); +my @unrecoverable_quality = (); +my @filter_list = (); +my %unique_filter_hash = (); + +# Grab the configuration data. +my $conf_cmd = "$ppConfigDump -camera $camera -dump-recipe NIGHTLY_SCIENCE -"; +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", 0, 0, $date, $PS_EXIT_SYS_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; +my $metadata = $mdcParser->parse(join "", @$stdout_buf); +foreach my $entry (@{ $metadata }) { + if (@{ $entry }{name} eq 'CLEAN_MODES') { + my @mode_data = @{ ${ $entry }{value} }; + my $this_mode = ''; + foreach my $mentry (@mode_data) { + if (${ $mentry }{name} eq 'MODE') { + $this_mode = ${ $mentry }{value}; + } + elsif (${ $mentry }{name} eq 'COMMAND') { + $clean_config{$this_mode}{COMMAND} = ${ $mentry }{value}; + } + elsif (${ $mentry }{name} eq 'RETENTION_TIME') { + $clean_config{$this_mode}{RETENTION_TIME} = ${ $mentry }{value}; + } + } + } + elsif (${ $entry }{name} eq 'FILTERS') { + $unique_filter_hash{ ${ $entry }{value} } = 1; +# push @filter_list, ${ $entry }{value}; + } + elsif (${ $entry }{name} eq 'UNRECOVERABLE_QUALITY') { + push @unrecoverable_quality, ${ $entry }{value}; + } + elsif (${ $entry }{name} eq 'MACRO_DEFINITIONS') { + my @macro_data = @{ ${ $entry }{value} }; + my $this_mode = ''; + foreach my $mentry (@macro_data) { + if (${ $mentry }{name} eq 'PROC_MODE') { + $this_mode = ${ $mentry }{value}; + } + elsif (${ $mentry }{name} eq 'MACRO') { + $macro_config{$this_mode} = ${ $mentry }{value}; + } + } + } + elsif (${ $entry }{name} eq 'TARGETS') { + my @target_data = @{ ${ $entry }{value} }; + my $this_target = ''; + foreach my $tentry (@target_data) { + if (${ $tentry }{name} eq 'NAME') { + $this_target = ${ $tentry }{value}; + $science_config{$this_target}{DISTRIBUTION} = $this_target; # Set the default dist_group + } + else { + $science_config{$this_target}{ ${ $tentry }{name} } = ${ $tentry }{value}; + } + } + } + elsif (${ $entry }{name} eq 'DETRENDS') { + my @detrend_data = @{ ${ $entry }{value} }; + my $this_detrend = ''; + foreach my $dentry (@detrend_data) { + if (${ $dentry }{name} eq 'NAME') { + $this_detrend = ${ $dentry }{value}; + } + else { + $detrend_config{$this_detrend}{ ${ $dentry }{name} } = ${ $dentry }{value}; + } + } + } + elsif (${ $entry }{name} eq 'END_OF_NIGHT') { + my @eon_data = @{ ${ $entry }{value} }; + my $this_eon = ''; + foreach my $tentry (@eon_data) { + if (${ $tentry }{name} eq 'NAME') { + $this_eon = ${ $tentry }{value}; + } + else { + $eon_config{$this_eon}{ ${ $tentry }{name} } = ${ $tentry }{value}; + } + } + } +} +@filter_list = sort(keys(%unique_filter_hash)); + +if (defined($date)) { + my $time; + if ($date =~ / /) { + ($date,$time) = split / /, $date; + } + elsif ($date =~ /T/) { + ($date,$time) = split /T/, $date; + } + my ($year,$month,$day) = split /-/, $date; + if (defined($time)) { + my ($hour,$min,$sec) = split /\:/, $time; #/; + $datetime = DateTime->new( year => $year, + month => $month, + day => $day, + hour => $hour, + min => $min, + second => $sec, + time_zone => 'UTC'); + } + else { + $datetime = DateTime->now(time_zone => 'UTC'); + $datetime->set_year($year); + $datetime->set_day($day); + $datetime->set_month($month); + } +} +else { + $datetime = DateTime->now(time_zone => 'UTC'); # time_zone => 'Pacific/Honolulu'); + $date = $datetime->ymd(); +} +$now = DateTime->now(time_zone => 'UTC'); + +if (defined($this_target_only)) { + foreach my $t (keys %science_config) { + if ($t ne $this_target_only) { + undef($science_config{$t}); + } + } + die("$this_target_only is invalid.") if (scalar keys %science_config < 1); +} + +if (defined($this_filter_only)) { + foreach my $t (@filter_list) { + if ($t eq $this_filter_only) { + @filter_list = ($this_filter_only); + last; + } + } + die("$this_filter_only is invalid.") if ($#filter_list != 0); +} + +if (defined($this_mode_only)) { + foreach my $t (keys %clean_config) { + if ($t ne $this_mode_only) { + undef($clean_config{$t}); + } + } + die("$this_mode_only is invalid.") if (scalar keys %clean_config < 1); +} + +$metadata_out{nsObservingState} = &get_observing_state($date); +$metadata_out{nsRegistrationState} = &get_registration_state($date); +if ($force_registration) { + $metadata_out{nsRegistrationState} = 'REGISTERED'; +} + +if (defined($desdiffdt) == 0) { + $desdiffdt = 1.5; +} + +#Build in a safety for desdiffdt +if ((defined($desdiffdt) == 1) && ($desdiffdt <= 0.5)) { + $desdiffdt = 0.5; +} + +# +# Mode selection +################################################################################ + +if (defined($test_mode)) { + $debug = 1; + my $z; + my $v; + foreach $z (sort (keys %science_config)) { + foreach $v (keys %{ $science_config{$z} }) { + print "SCIENCE: $z $v $science_config{$z}{$v}\n"; + } + } + foreach $z (sort (keys %detrend_config)) { + foreach $v (keys %{ $detrend_config{$z} }) { + print "DETREND: $z $v $detrend_config{$z}{$v}\n"; + } + } + foreach $z (keys (%clean_config)) { + foreach $v (keys %{ $clean_config{$z} }) { + print "CLEAN: $z $v $clean_config{$z}{$v}\n"; + } + } + foreach $z (@filter_list) { + print "FILTER: $z\n"; + } + foreach $z (keys (%macro_config)) { + print "MACROS: $z $macro_config{$z}\n"; + } +} +if (defined($observing_status) || defined($test_mode)) { + $metadata_out{nsState} = 'CHECK_OBSERVING_STATUS'; + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} + +if (defined($registration_status) || defined($test_mode)) { + &check_summit_copy($date); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} + +if (defined($burntool_status) || defined($test_mode)) { + &burntool_status($date); + unless (defined($test_mode)) { exit(0); } +} + +if (defined($check_dqstats) || defined($test_mode)) { + &execute_dqstats($date,"pretend"); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} +if (defined($queue_dqstats)) { + &execute_dqstats($date); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} + +if (defined($check_detrends) || defined($test_mode)) { + $metadata_out{nsDetState} = 'CHECKDETRENDS'; + &execute_detrends($date,"pretend"); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} +if (defined($queue_detrends)) { + $metadata_out{nsDetState} = 'QUEUEDETRENDS'; + &execute_detrends($date); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} + +if (defined($clean_old) || defined($test_mode)) { + if (defined($test_mode)) { + &execute_cleans($date,"pretend"); + } + else { + &execute_cleans($date); + } + unless (defined($test_mode)) { exit(0); } +} + +if (defined($check_stacks) || defined($test_mode)) { + $metadata_out{nsStackState} = 'TOWARP'; + &execute_stacks($date,$metadata_out{nsObservingState},"pretend"); + if ($metadata_out{nsStackState} eq 'FORCETOWARP') { + $metadata_out{nsStackState} = 'TOWARP'; + } + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} +if (defined($queue_stacks)) { + $metadata_out{nsStackState} = 'STACKING'; + &execute_stacks($date,$metadata_out{nsObservingState}); + if ($metadata_out{nsStackState} eq 'QUEUESTACKING') { + $metadata_out{nsStackState} = 'STACKING_POSSIBLE_ERROR'; + } + return_metadata($date); + exit(0); +} + +if (defined($check_diffs) || defined($test_mode)) { + $metadata_out{nsDiffState} = 'TOWARP'; + &execute_diffs($date,$metadata_out{nsObservingState},"pretend"); + if ($metadata_out{nsDiffState} eq 'FORCETOWARP') { + $metadata_out{nsDiffState} = 'TOWARP'; + } + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} +if (defined($queue_diffs)) { + $metadata_out{nsDiffState} = 'DIFFING'; + &execute_diffs($date,$metadata_out{nsObservingState}); + if ($metadata_out{nsDiffState} eq 'QUEUESTACKING') { + $metadata_out{nsDiffState} = 'STACKING_POSSIBLE_ERROR'; + } + return_metadata($date); + exit(0); +} + +if (defined($check_confirm_stacks) || defined($test_mode)) { + $metadata_out{nsStackState} = 'CONFIRM_STACKING'; + &confirm_stacks($date,"pretend"); + return_metadata($date); + unless (defined($test_mode)) { exit(0); } +} +if (defined($confirm_stacks)) { + $metadata_out{nsStackState} = 'CONFIRM_STACKING'; + &confirm_stacks($date); + return_metadata($date); + exit(0); +} +exit(10); +if (defined($check_sweetspot) || defined($test_mode) || defined($check_mode)) { + $metadata_out{nsSSState} = 'CHECKSWEETSPOT'; + &execute_sweetspot($date,"pretend"); + return_metadata($date); + unless (defined($test_mode) || defined($check_mode)) { exit(0); } +} +if (defined($queue_sweetspot)) { + $metadata_out{nsSSState} = 'CHECKSWEETSPOT'; + &execute_sweetspot($date); + return_metadata($date); + exit(0); +} + +exit(0); +# +# Registration +################################################################################ +# This isn't used, but might be useful to keep. + +sub check_summit_copy { + my $date = shift; + my $db = init_gpc_db(); + + # largely stolen from Bill's checkexp program. + + my $sth = " SELECT exp_name, summitExp.dateobs AS registered, rawExp.dateobs, summitExp.imfiles, "; + $sth .= " summitExp.fault AS summit_fault, pzDownloadExp.state AS download_state, "; + $sth .= " count(pzDownloadImfile.class_id) AS download_count, newExp.state AS newExp_state, newExp.exp_id, summitExp.exp_type"; + $sth .= " FROM summitExp LEFT JOIN pzDownloadExp USING(exp_name) LEFT JOIN pzDownloadImfile USING(exp_name) "; + $sth .= " LEFT JOIN newExp ON exp_name = tmp_exp_name LEFT JOIN rawExp USING(exp_id, exp_name) "; + $sth .= " WHERE date(summitExp.dateobs) >= '${date}T00:00:00' AND date(summitExp.dateobs) <= '${date}T23:59:59' "; + $sth .= " GROUP BY exp_name ORDER BY summitExp.dateobs "; + + my $data_ref = $db->selectall_arrayref( $sth ); + + my $Nsummit_exps = 0; + my $Nsummit_faults = 0; + my $Ndownload_faults = 0; + my $Nregister_faults = 0; + my $Ndownload_imfiles = 0; + my $Nsummit_imfiles = 0; +# my_trace($sth,$data_ref,$#{ $data_ref }); + + foreach my $row_ref (@{ $data_ref }) { + my ($exp_name,$registered,$dateobs,$imfiles,$summit_fault, + $download_state,$download_count,$new_state,$exp_id,$exp_type) = @{ $row_ref }; + $Nsummit_imfiles += $imfiles; + $Ndownload_imfiles += $download_count; + $Nsummit_exps++; + if ($summit_fault) { + print STDERR "check_summit_copy: $date $exp_name has summit_fault $summit_fault"; + if (($exp_type ne 'OBJECT')||($exp_name =~ /^c.*/)) { + print STDERR " (but I don't care).\n"; + } + else { + print STDERR "\n"; + $Nsummit_faults++; + } + } + elsif (!$download_state or $download_state eq 'run') { + print STDERR "check_summit_copy: $date $exp_name has download_state $download_state"; + if (($exp_type ne 'OBJECT')||($exp_name =~ /^c.*/)) { + print STDERR " (but I don't care).\n"; + } + else { + print STDERR "\n"; + $Ndownload_faults++; + } + } + elsif (!$new_state or $new_state eq 'run' ) { + print STDERR "check_summit_copy: $date $exp_name has new_state $new_state"; + if (($exp_type ne 'OBJECT')||($exp_name =~ /^c.*/)) { + print STDERR " (but I don't care).\n"; + } + else { + print STDERR "\n"; + $Nregister_faults++; + } + } + } + + my $Nfaults = $Nsummit_faults + $Ndownload_faults + $Nregister_faults; + if ($Nsummit_exps == 0) { + print STDERR "No exposures were found on the summit for $date.\n"; + $metadata_out{nsRegState} = 'DROP'; + } + elsif ($Nfaults != 0) { + print STDERR "There were faults while downloading the exposures for $date.\n"; + $metadata_out{nsRegState} = 'NEW'; + } + elsif ($Ndownload_imfiles != $Nsummit_imfiles) { + print STDERR "Not done downloading from the summit for $date (Summit: $Nsummit_imfiles, Downloaded: $Ndownload_imfiles)\n"; + $metadata_out{nsRegState} = 'NEW'; + } + else { + print STDERR "Summit copy and Registration have succeeded for $date.\n"; + $metadata_out{nsRegState} = 'REGISTERED'; + } + + return($Nsummit_exps,$Nfaults); +} + +# +# Burntool +################################################################################ + +sub get_goodBTvalue { + my $mdcParser = PS::IPP::Metadata::Config->new; + + my $config_cmd = "$ppConfigDump -camera $camera -get-key BURNTOOL.STATE.GOOD"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $config_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", 0, 0, 0, $PS_EXIT_SYS_ERROR); + } + my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", 0, 0, 0, $PS_EXIT_SYS_ERROR); + my $burntoolStateGood = 999; + foreach my $cfg (@$recipeData) { + if ($cfg->{name} eq 'BURNTOOL.STATE.GOOD') { + $burntoolStateGood = $cfg->{value}; + } + } + if ($burntoolStateGood == 999) { + &my_die("Failed to determine BURNTOOL.STATE.GOOD", $burntoolStateGood, 0, 0, $PS_EXIT_SYS_ERROR); + } + return($burntoolStateGood); +} + +sub verify_burntool { + my $exp_id = shift; + my $burntoolStateGood = shift; + + my $db = init_gpc_db(); + + my $sth = "SELECT exp_id,exp_name,obs_mode,dateobs,class_id,burntool_state,comment FROM rawImfile WHERE exp_id = $exp_id"; + my $data_ref = $db->selectall_arrayref( $sth ); + + my $Nimfiles = 0; + my $Nburntooled = 0; + + foreach my $row_ref (@{ $data_ref }) { + my ($exp_id,$exp_name, $obs_mode,$dateobs,$class_id,$burntool_state,$comment) = @{ $row_ref }; + $Nimfiles++; + if (abs($burntool_state) == $burntoolStateGood) { + $Nburntooled++; + } + } + return($Nimfiles,$Nburntooled); +} + +# +# Chips +################################################################################ +# This no longer queues chips, it only checks the counts and returns that. +sub construct_chiptool_cmd { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $select = "-dateobs_begin ${date}T00:00:00 -dateobs_end ${date}T23:59:59 "; + $date =~ s/-//g; + + my $cmd = "$chiptool"; + $cmd .= " -simple -dbname $dbname -definebyquery -set_end_stage warp "; + $cmd .= " -set_label $label "; + $cmd .= " -set_workdir $workdir -set_dist_group $dist_group "; + $cmd .= " -set_tess_id $tess_id -set_data_group $data_group "; + if (defined($obs_mode)) { + $cmd .= " -obs_mode '$obs_mode' "; + } + if (defined($object)) { + $cmd .= " -object '$object' "; + } + if (defined($comment)) { + $cmd .= " -comment '$comment' "; + } + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + $cmd .= " $select "; + if ($debug == 1) { + $cmd .= " -pretend "; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub verify_uniqueness_chip { + my $exp_id = shift; + my $date = shift; + my $target = shift; + + my $db = init_gpc_db(); + $date =~ s/-//g; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $sth = "SELECT exp_id from chipRun where data_group = '$data_group' AND exp_id = $exp_id"; + my $data_ref = $db->selectall_arrayref( $sth ); + + return($#{ $data_ref } + 1); +} + +sub check_chip_status { + my $date = shift; + my $target = shift; + + my $command = construct_chiptool_cmd($date,$target) . ' -pretend '; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + + my $burntoolStateGood = get_goodBTvalue(); + my $Nimfiles = 0; + my $Nburntooled = 0; + my $Nalready = 0; + my @input_exposures = split /\n/, (join '', @$stdout_buf); + foreach my $entry (@input_exposures) { + my ($exp_id, @trash) = split /\s+/, $entry; + @trash = verify_burntool($exp_id,$burntoolStateGood); + $Nimfiles += $trash[0]; + $Nburntooled += $trash[1]; + + @trash = verify_uniqueness_chip($exp_id,$date,$target); + $Nalready += $trash[0]; + } + return($#input_exposures + 1,$Nimfiles,$Nburntooled,$Nalready); +} + +sub burntool_status { + my $date = shift; + my $exposures = 0; + + foreach my $target (sort (keys %science_config)) { + my ($Nexposures,$Nimfiles,$Nburntooled,$Nalready) = check_chip_status($date,$target); + print "BTSTATS: $date $target $Nexposures $Nimfiles $Nburntooled $Nalready\n"; + } +} + + +# +# DQstats +################################################################################ + +sub construct_dqstats_cmd { + my $date = shift; + + my $select = "-dateobs_end ${date}T23:59:59 "; + + my $cmd = "$dqstatstool"; + $cmd .= " -simple -dbname $dbname -definebyquery "; + $cmd .= " $select "; + $cmd .= " -label %.nightlyscience "; + $cmd .= " -set_label dqstats.nightlyscience "; + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub pre_dqstats_queue { + my $date = shift; + + my $command = construct_dqstats_cmd($date) . ' -pretend '; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dqstatstool: $error_code",1,1,,$date, $PS_EXIT_SYS_ERROR); + } + + my @input_exposures = split /\n/, (join '', @$stdout_buf); + + return($#input_exposures + 1,1,1); +} + +sub dqstats_queue { + my $date = shift; + + my $command = construct_dqstats_cmd($date); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dqstatstool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + return(0); + +} +sub execute_dqstats { + my $date = shift; + my $pretend = shift; + my ($Nexposures,$Nchips,$Ncams) = pre_dqstats_queue($date); + if ($Nexposures == 0) { + print STDERR "execute_dqstats: No exposures on date $date.\n"; + } + elsif ($Ncams != $Nchips) { + print STDERR "execute_dqstats: Not done processing data through camera stage.\n"; + } + else { + unless(defined($pretend)) { + dqstats_queue($date); + } + if (defined($pretend)) { + add_to_macro_list('check_dqstats',1,$date); + } + else { + add_to_macro_list('queue_dqstats',1,$date); + } + } +} +# +# Detrend verification +################################################################################ + +sub construct_dettool_cmd { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$filter,$exp_type,$det_type,$ref_det_id,$ref_iter,$maxN) = get_dettool_parameters($date,$target); + + my $select = "-select_dateobs_begin ${date}T00:00:00 -select_dateobs_end ${date}T23:59:59 "; + my $use_limits = " -use_begin ${date}T00:00:00 -use_end ${date}T23:59:59 "; + $date =~ s/-//g; + + my $cmd = "$dettool"; +# $cmd .= " -pretend "; + $cmd .= " -simple -dbname $dbname -definebyquery -det_type $det_type "; + $cmd .= " -mode verify -ref_det_id $ref_det_id -ref_iter $ref_iter "; + $cmd .= " $select "; + $cmd .= " -inst $camera "; + $cmd .= " -select_exp_type $exp_type "; + $cmd .= " -select_filter $filter " if defined($filter); + $cmd .= " -workdir $workdir "; + $cmd .= " -label $label "; + $cmd .= " $use_limits "; + if ($maxN > 0) { + $cmd .= " -random_subset -random_limit $maxN "; + } + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub verify_uniqueness_detverify { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$filter,$exp_type,$det_type,$ref_det_id,$ref_iter,$maxN) = get_dettool_parameters($date,$target); + + my $db = init_gpc_db(); + my $sth = "SELECT * FROM detRun WHERE workdir = '$workdir' AND ref_det_id = $ref_det_id AND ref_iter = $ref_iter"; + my $data_ref = $db->selectall_arrayref( $sth ); + + return($#{ $data_ref } + 1); +} + +sub pre_detrend_queue { + my $date = shift; + my $target = shift; + + my $command = construct_dettool_cmd($date,$target) . ' -pretend '; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dettool: $error_code", 0,0, $date, $PS_EXIT_SYS_ERROR); + } + + my @input_exposures = split /\n/, (join '', @$stdout_buf); + return($#input_exposures + 1); +} + +sub detrend_queue { + my $date = shift; + my $target = shift; + + my $command = construct_dettool_cmd($date,$target); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform chiptool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + $metadata_out{nsDetState} = 'DETREND_QUEUED'; + return(0); + +} +sub execute_detrends { + my $date = shift; + my $pretend = shift; + my $exposures = 0; + foreach my $target (sort (keys %detrend_config)) { + my ($Nexposures) = pre_detrend_queue($date,$target); + if ($Nexposures == 0) { + print STDERR "execute_detrends: Target $target on $date had no exposures.\n"; + next; + } + $exposures++; + unless(defined($pretend)) { + detrend_queue($date,$target); + } + if (defined($pretend)) { + add_to_macro_list('check_detrends',1,$date,$target,"dettool"); + } + else { + add_to_macro_list('queue_detrends',1,$date,$target,"dettool"); + } + } + if ($exposures == 0) { + $metadata_out{nsDetState} = 'DETREND_DROP'; + } + if (($metadata_out{nsDetState} eq 'CHECKDETRENDS') && ($exposures > 0)) { + $metadata_out{nsDetState} eq 'QUEUEDETRENDS'; + } +} + +# # +# # SweetSpot Stacking +# ################################################################################ +# sub construct_sweetspot_cmd { +# my $date = shift; +# my $target = 'SweetSpot'; +# my $filter = 'w.00000'; + +# my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + +# # Dateobs begin end? +# my ($dateobs_begin,$dateobs_end) = get_lunation_extent($date); +# my $select = "-select_dateobs_begin ${dateobs_begin}T00:00:00 -select_dateobs_end ${dateobs_end}T00:00:00"; +# my $cmd = "$stacktool"; +# $cmd .= " -simple -dbname $dbname -definebyquery "; +# $cmd .= " -set_label SweetSpot.refstack -select_label $label "; +# $cmd .= " -set_workdir $workdir -set_dist_group $dist_group "; +# $cmd .= " -select_filter $filter -set_data_group $data_group "; +# $cmd .= " -select_good_frac_min 0.1 -select_fwhm_major_max 8.0 "; +# $cmd .= " -min_num 7 -min_new 4"; +# $cmd .= " $select "; +# if ($debug == 1) { +# $cmd .= ' -pretend '; +# } +# print STDERR "$cmd\n"; +# return($cmd); +# } + +sub get_lunation_extent { + my $date = shift; + my ($year,$month,$day) = split /-/,$date; + my $dateobs_begin; + my $dateobs_end; + + my $dt = DateTime->new(year => $year, month => $month, day => $day, + hour => 0, minute => 0, second => 0, nanosecond => 0, + time_zone => 'Pacific/Honolulu'); + do { + $dt->add(days => 1); + my $ymd = $dt->ymd; + my $md_cmd = "moondata $ymd 0 0"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $md_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform moondata: $error_code", 0,0, $date, $PS_EXIT_SYS_ERROR); + } + my @result = split /\s+/,(join "\n", @$stdout_buf); + if (abs($result[6]) <= 0.6) { + $dateobs_end = $ymd; + } + } while (!defined($dateobs_end)); + + do { + $dt->subtract(days => 1); + my $ymd = $dt->ymd; + my $md_cmd = "moondata $ymd 0 0"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $md_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform moondata: $error_code", 0,0, $date, $PS_EXIT_SYS_ERROR); + } + my @result = split /\s+/,(join "", @$stdout_buf); + if (abs($result[6]) <= 0.6) { + $dateobs_begin = $ymd; + } + } while (!defined($dateobs_begin)); + + return($dateobs_begin,$dateobs_end); +} + +# sub pre_sweetspot_queue { +# my $date = shift; +# my $command = construct_sweetspot_cmd($date) . ' -pretend '; +# my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run ( command => $command, verbose => $verbose ); +# unless ($success) { +# $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); +# &my_die("Unable to perform sweetspot stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); +# } +# my @stacks = split /\n/, (join '', @$stdout_buf); +# my $Nstacks = $#stacks + 1; + +# return(1,$Nstacks); +# } + +# sub sweetspot_queue { +# my $date = shift; +# my $command = construct_sweetspot_cmd($date); +# my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run ( command => $command, verbose => $verbose ); +# unless ($success) { +# $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); +# &my_die("Unable to perform sweetspot stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); +# } +# my @stacks = split /\n/, (join '', @$stdout_buf); +# my $Nstacks = $#stacks + 1; + +# return(1,$Nstacks); +# } + +# sub execute_sweetspot { +# my $date = shift; +# my $pretend = shift; + +# my ($is_lunation_date,$Nstacks) = pre_sweetspot_queue($date); +# if ($Nstacks == 0) { +# print STDERR "execute_sweetspot: No new stacks to make ($Nstacks)\n"; +# $metadata_out{nsSSState} = 'SS_EMPTY'; +# return(); +# } +# if ($Nstacks < 10) { +# print STDERR "execute_sweetspot: Too few new stacks to make ($Nstacks)\n"; +# $metadata_out{nsSSState} = 'SS_FEW'; +# return(); +# } +# if ($is_lunation_date == 0) { +# print STDERR "execute_sweetspot: Invalid lunation date. ($date $is_lunation_date)\n"; +# $metadata_out{nsSSState} = 'SS_ERROR'; +# return(); +# } +# $metadata_out{nsSSState} = 'SS_QUEUE'; +# $metadata_out{nsSweetSpot} = $Nstacks; +# unless(defined($pretend)) { +# $metadata_out{nsSSState} = 'SS_DONE'; +# sweetspot_queue($date); +# } +# if (defined($pretend)) { +# add_to_macro_list('check_sweetspot',1,$date); +# } +# else { +# add_to_macro_list('queue_sweetspot',1,$date); +# } +# } + +# +# Stacking +################################################################################ + + +sub construct_stacktool_cmd { + my $date = shift; + my $target = shift; + my $filter = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $select = "-select_dateobs_begin ${date}T00:00:00 -select_dateobs_end ${date}T23:59:59 "; + $date =~ s/-//g; + + my $cmd = "$stacktool"; +# $cmd .= ' -pretend -simple -dbname gpc1 -definebyquery -min_new 4 '; # Probably silly, but I want to be safe and not overwrite + $cmd .= " -simple -dbname $dbname -definebyquery "; + $cmd .= " -set_label $label -select_label $label "; + $cmd .= " -set_workdir $workdir -set_dist_group $dist_group "; + $cmd .= " -select_filter $filter -set_data_group $data_group "; + $cmd .= " -min_num 4"; + $cmd .= " -select_good_frac_min 0.05"; + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + else { + $cmd .= " -set_reduction NIGHTLY_STACK "; + } + if (defined($science_config{$target}{ADDITIONAL_STACK_LABEL})) { + # Grab list of skycells + my $skycell_select = ''; + { + my %skycells = (); + my $warpcmd = "$warptool -warped -label $label -data_group $data_group -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = + run(command => $warpcmd, verbose => $verbose); + unless($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unabel to perform warptool -warped to determine skycell_ids: $error_code",$target); + } + my $runs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unabel to parse warptool -warped to determine skycell_ids: $error_code",$target); + if ($#{ $runs } != -1) { + for my $warp (@$runs) { + $skycells{$warp->{skycell_id}} = 1; + } + foreach my $skycell (sort (keys (%skycells))) { + $skycell_select .= " -select_skycell_id $skycell "; + } + $cmd .= " -select_label $science_config{$target}{ADDITIONAL_STACK_LABEL} $skycell_select "; + } + } + } + $cmd .= " $select "; + if ($debug == 1) { + $cmd .= ' -pretend '; + } + print STDERR "$cmd\n"; + return($cmd); +} + +sub verify_uniqueness_stack { + my $skycell = shift; + my $date = shift; + my $target = shift; + my $filter = shift; + + my $db = init_gpc_db(); + $date =~ s/-//g; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $sth = "SELECT skycell_id from stackRun where data_group = '$data_group' AND skycell_id = '$skycell' AND filter = '$filter' AND tess_id = '$tess_id'"; + my $data_ref = $db->selectall_arrayref( $sth ); + + return($#{ $data_ref } + 1); +} + +sub pre_stack_queue { + my $date = shift; + my $observing_state = shift; + my $target = shift; + my $filter = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $db = init_gpc_db(); + + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $where = " label = '$label' AND data_group = '$data_group' "; + + my $where_possibly_faulted = $where . " AND ( " ; + foreach my $acceptable_quality (@unrecoverable_quality) { + $where_possibly_faulted .= " quality = $acceptable_quality OR "; + } + $where_possibly_faulted .= " 0 )"; + + my $chip_sth = "SELECT * from chipRun WHERE (state = 'full' OR state = 'new') AND $where "; + my $cam_sth = "SELECT * from camRun JOIN camProcessedExp USING(cam_id) WHERE state = 'full' AND $where_possibly_faulted "; + my $warp_sth = "SELECT * from warpRun WHERE state = 'full' AND $where "; + + my $chip_ref = $db->selectall_arrayref( $chip_sth ); + my $cam_ref = $db->selectall_arrayref( $cam_sth ); + my $warp_ref = $db->selectall_arrayref( $warp_sth ); + + # check that we will be able to queue them up + my $command = construct_stacktool_cmd($date,$target,$filter) . ' -pretend '; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", $#{ $chip_ref },$#{ $warp_ref },$date, $PS_EXIT_SYS_ERROR); + } + + my $Nalready = 0; + + my @input_exposures = split /\n/, (join '', @$stdout_buf); + foreach my $entry (@input_exposures) { + my ($warp_tess_id,$skycell, @trash) = split /\s+/, $entry; + @trash = verify_uniqueness_stack($skycell,$date,$target,$filter); + $Nalready += $trash[0]; + } + + my $minimum_required_warp; + if ($observing_state eq 'OBSERVING') { + $minimum_required_warp = $science_config{$target}{MIN_STACK}; + } + unless (defined($minimum_required_warp)) { + $minimum_required_warp = 0; + } + + return($#input_exposures + 1, $#{ $chip_ref } + 1, $#{ $cam_ref } + $#{ $warp_ref } + 2, $minimum_required_warp, $Nalready); +} + +sub stack_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + + my $command = construct_stacktool_cmd($date,$target,$filter); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + + + return(0); +} + +sub execute_stacks { + my $date = shift; + my $observing_state = shift; + my $pretend = shift; + + my $Npotential = 0; + my $Nqueued = 0; + my $is_processing = 0; + my $is_registering; + if ($metadata_out{nsRegistrationState} eq 'REGISTERED') { + $is_registering = 0; + } + else { + $is_registering = 1; + } + + foreach my $target (sort (keys %science_config)) { + if ($science_config{$target}{STACKABLE} == 1) { + foreach my $filter (@filter_list) { + my ($Nexposures,$NprocChips,$NprocWarps,$NrequiredWarps,$Nalready) = pre_stack_queue($date,$observing_state,$target,$filter); + if ((!defined($force_stack_count))&&($NprocChips != $NprocWarps)) { # This makes me sad. :( + if ($debug == 1) { + print STDERR "execute_stacks: Target $target on $date is not fully processed. ($NprocChips $NprocWarps)\n"; + } + $is_processing = 1; + $metadata_out{nsStackState} = 'FORCETOWARP'; + next; + } + if ($Nexposures == 0) { + if ($debug == 1) { + print STDERR "execute_stacks: Target $target in filter $filter on $date has no exposures.\n"; + } + next; + } + if ($NprocWarps < $NrequiredWarps) { + if ($debug == 1) { + print STDERR "execute_stacks: Target $target in filter $filter on $date has too few warps to begin stacking. ($NprocWarps $NrequiredWarps)\n"; + } + next; + } + $Npotential++; + if ($Nalready != 0) { + $Nqueued++; + if ($debug == 1) { + print STDERR "execute_stacks: Not queueing $target in filter $filter on $date due to already existing stacks.\n"; + } + unless ($metadata_out{nsStackState} eq 'FORCETOWARP') { + $metadata_out{nsStackState} = 'STACKING'; + } + next; + } + unless (($metadata_out{nsStackState} eq 'FORCETOWARP')||($metadata_out{nsStackState} eq 'STACKING')) { + $metadata_out{nsStackState} = 'QUEUESTACKS'; + } + unless(defined($pretend)) { + if ($debug == 1) { + print STDERR "execute_stacks: Target $target in filter $filter on $date has exposures and will be queued.\n"; + } + stack_queue($date,$target,$filter); + $Nqueued ++; + } + if (defined($pretend)) { + add_to_macro_list('check_stacks',$science_config{$target}{STACKABLE},$date,$target,$filter); + } + else { + add_to_macro_list('queue_stacks',$science_config{$target}{STACKABLE},$date,$target,$filter); + } + } + } + else { + if ($debug == 1) { + print STDERR "execute_stacks: Target $target is not auto-stackable.\n"; + } + } + } + $metadata_out{nsStackPotential} = $Npotential; + $metadata_out{nsStackQueued} = $Nqueued; + if (($Npotential == $Nqueued)&&($metadata_out{nsObservingState} eq 'END_OF_NIGHT')&&($is_processing == 0)&&($is_registering == 0)) { + $metadata_out{nsStackState} = 'FINISHED_STACKS'; + } +} + +sub post_stack_queue { + my $date = shift; + my $target = shift; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + # check warp stage == chip stage + my $db = init_gpc_db(); + + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $where = " label = '$label' AND data_group = '$data_group' "; + + my $stack_full_sth = "SELECT * from stackRun where $where "; + my $stack_done_sth = "SELECT * from stackRun LEFT JOIN stackSumSkyfile USING(stack_id) WHERE $where "; + $stack_done_sth .= " AND ((state = 'full') OR (state = 'new' && fault != 0)) "; + if ($debug == 1) { + print STDERR "post_stack_queue: database queries:\n"; + print STDERR "$stack_full_sth\n"; + print STDERR "$stack_done_sth\n"; + } + my $stack_full_ref = $db->selectall_arrayref( $stack_full_sth ); + my $stack_done_ref = $db->selectall_arrayref( $stack_done_sth ); + + return($#{ $stack_full_ref } + 1, $#{ $stack_done_ref } + 1); +} + +sub confirm_stacks { + my $date = shift; + my $pretend = shift; + + foreach my $target (sort (keys %science_config)) { + if ($science_config{$target}{STACKABLE} == 1) { + my ($Nstacks, $Nattempted) = post_stack_queue($date,$target); + if ($debug == 1) { + print STDERR "confirm_stacks: Target $target on $date has $Nattempted attempts on $Nstacks.\n"; + } + if ($Nstacks != $Nattempted) { + if ($debug == 1) { + print STDERR "confirm_stacks: Target $target on $date is not done stacking. $Nstacks $Nattempted\n"; + } + if ($metadata_out{nsStackState} eq 'CONFIRM_STACKING') { + $metadata_out{nsStackState} = 'STACKING'; + } + next; + } + if ($Nstacks == 0) { + if ($debug == 1) { + print STDERR "confirm_stacks: Target $target on $date has no stacks. Skipping.\n"; + } + next; + } + if ($metadata_out{nsStackState} eq 'CONFIRM_STACKING') { + if (defined($pretend)) { + add_to_macro_list('check_confirm_stacks',$science_config{$target}{STACKABLE},$date,$target); + } + else { + add_to_macro_list('confirm_stacks',$science_config{$target}{STACKABLE},$date,$target); + } + } + } + } +} + +# +# Extra processing +################################################################################ + +sub verify_uniqueness_diff { + my $warp_id_1 = shift; + my $warp_id_2 = shift; + my $date = shift; + my $target = shift; + + my $db = init_gpc_db(); + $date =~ s/-//g; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $count = 0; + + my $sth = "SELECT DISTINCT diff_id from diffRun JOIN diffInputSkyfile USING(diff_id) where data_group = '$data_group' AND warp1 = $warp_id_1 AND warp2 = $warp_id_2"; + my $data_ref = $db->selectall_arrayref( $sth ); + $count += $#{ $data_ref } + 1; + + $sth = "SELECT DISTINCT diff_id from diffRun JOIN diffInputSkyfile USING(diff_id) where data_group = '$data_group' AND warp1 = $warp_id_2 AND warp2 = $warp_id_1"; + $data_ref = $db->selectall_arrayref( $sth ); + $count += $#{ $data_ref } + 1; + + return($count); +} + +sub multi_date_verify_uniqueness_diff { + my $warp_id_1 = shift; + my $warp_id_2 = shift; + my $date = shift; + my $target = shift; + + my $db = init_gpc_db(); + $date =~ s/-//g; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $count = 0; + + my $sth = "SELECT DISTINCT diff_id from diffRun JOIN diffInputSkyfile USING(diff_id) where (label = '$label' OR label = 'goto_cleaned') AND warp1 = $warp_id_1 AND warp2 = $warp_id_2"; + my $data_ref = $db->selectall_arrayref( $sth ); + $count += $#{ $data_ref } + 1; + + $sth = "SELECT DISTINCT diff_id from diffRun JOIN diffInputSkyfile USING(diff_id) where (label = '$label' OR label = 'goto_cleaned') AND warp1 = $warp_id_2 AND warp2 = $warp_id_1"; + $data_ref = $db->selectall_arrayref( $sth ); + $count += $#{ $data_ref } + 1; + + return($count); +} + +sub pre_diff_queue { + my $date = shift; + my $observing_state = shift; + my $target = shift; + my $filter = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $db = init_gpc_db(); + + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $where = " label = '$label' AND data_group = '$data_group' "; + + my $where_possibly_faulted = $where . " AND ( " ; + foreach my $acceptable_quality (@unrecoverable_quality) { + $where_possibly_faulted .= " quality = $acceptable_quality OR "; + } + $where_possibly_faulted .= " 0 )"; + + my $chip_sth = "SELECT * from chipRun WHERE (state = 'full' OR state = 'new') AND $where "; + my $cam_sth = "SELECT * from camRun JOIN camProcessedExp USING(cam_id) WHERE state = 'full' AND $where_possibly_faulted "; + my $warp_sth = "SELECT * from warpRun WHERE state = 'full' AND $where "; + + my $chip_ref = $db->selectall_arrayref( $chip_sth ); + my $cam_ref = $db->selectall_arrayref( $cam_sth ); + my $warp_ref = $db->selectall_arrayref( $warp_sth ); + + return($#{ $chip_ref } + 1, $#{ $cam_ref } + $#{ $warp_ref } + 2); +} + +sub execute_diffs { + my $date = shift; + my $observing_state = shift; + my $pretend = shift; + + my $Npotential = 0; + my $Nnoexp = 0; + my $is_processing = 0; + my $is_registering; + if ($metadata_out{nsRegistrationState} eq 'REGISTERED') { + $is_registering = 0; + } + else { + $is_registering = 1; + } + + foreach my $target (sort (keys %science_config)) { + if ($science_config{$target}{DIFFABLE} == 1) { + foreach my $filter (@filter_list) { + $Npotential ++; + my ($NprocChips,$NprocWarps) = pre_diff_queue($date,$observing_state,$target,$filter); + if ((!defined($force_diff_count))&&($NprocChips != $NprocWarps)) { + if ($debug == 1) { + print STDERR "execute_diffs: Target $target in filter $filter on $date is not fully processed. ($NprocChips $NprocWarps)\n"; + } + $is_processing = 1; + } + if ($NprocChips == 0) { + $Nnoexp ++; + if ($debug == 1) { + print STDERR "execute_diffs: Target $target in filter $filter on $date has no exposures.\n"; + } + next; + } + unless (($metadata_out{nsDiffState} eq 'FORCETOWARP')||($metadata_out{nsDiffState} eq 'DIFFING')) { + $metadata_out{nsDiffState} = 'QUEUEDIFFS'; + } + if ($debug == 1) { + print STDERR "execute_diffs: Target $target in filter $filter on $date has exposures and will be queued.\n"; + } + diff_queue($date,$target,$filter,$pretend); + + #Queue up desperate diffs if the conditions are right for them + if ((defined($science_config{$target}{DESPERATE_DIFFS})) && ($science_config{$target}{DESPERATE_DIFFS} == 1)) { + desperate_diff_singles($date,$target,$filter,$pretend); + } + + if (defined($pretend)) { + add_to_macro_list('check_diffs',$science_config{$target}{DIFFABLE},$date,$target,$filter); + } + else { + add_to_macro_list('queue_diffs',$science_config{$target}{DIFFABLE},$date,$target,$filter); + } + } + } + else { + if ($debug == 1) { + print STDERR "execute_diffs: Target $target is not auto-diffable.\n"; + } + } + } + if ($debug == 1) { + print "$metadata_out{nsObservingState} $metadata_out{nsDiffPotential} $metadata_out{nsDiffQueued} $is_processing $is_registering\n"; + } + + if ($metadata_out{nsObservingState} eq 'END_OF_NIGHT') { + if ($is_processing == 1) { + $metadata_out{nsDiffState} = 'DIFFING'; + } + elsif ($is_registering == 0) { + if ($Npotential == $Nnoexp) { + $metadata_out{nsDiffState} = 'FINISHED_DIFFS'; + } + elsif ($metadata_out{nsDiffPotential} == $metadata_out{nsDiffQueued}) { + $metadata_out{nsDiffState} = 'FINISHED_DIFFS'; + } + } + else { + $metadata_out{nsDiffState} = 'DIFFING'; + } + } + else { + $metadata_out{nsDiffState} = 'DIFFING'; + } + if ($metadata_out{nsDiffState} eq 'FINISHED_DIFFS') { + foreach my $target (sort (keys %science_config)) { + # CZW: We should only arrive at this point once, so we can construct a diff report and mail it now. + if ((defined($science_config{$target}{DESPERATE_DIFFS})) && ($science_config{$target}{DESPERATE_DIFFS} == 1)) { + foreach my $filter (@filter_list) { + # This one needs to return a state to see if we need to wait on stacking before checking again. + $metadata_out{nsDiffState} = desperate_diff_queue($date,$target,$filter,$pretend); + } + } + + if ((defined($science_config{$target}{SELF_WSDIFFS})) && ($science_config{$target}{SELF_WSDIFFS} == 1)) { + foreach my $filter (@filter_list) { + # This one needs to return a state to see if we need to wait on stacking before checking again. + $metadata_out{nsDiffState} = self_WS_diff_queue($date,$target,$filter,$pretend); + } + } + } + } + +# if (($Npotential == $Nnoexp)&&($metadata_out{nsObservingState} eq 'END_OF_NIGHT')&&($is_processing == 0)) { +# $metadata_out{nsDiffState} = 'FINISHED_DIFFS'; +# } + +# if ($is_processing == 1) { +# $metadata_out{nsDiffState} = 'DIFFING'; +# } +} + +sub diff_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + my $pretend = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $db = init_gpc_db(); + + my $obj_sth = "select DISTINCT rawExp.object from warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) "; + $obj_sth .= " WHERE warpRun.state = 'full' AND warpRun.label = '$label' AND warpRun.data_group = '$data_group' AND rawExp.filter = '$filter' ORDER BY rawExp.object"; + + my $object_ref = $db->selectall_arrayref( $obj_sth ); + + my $Npotential = 0; + my $Nqueued = 0; + + foreach my $object_row (@{ $object_ref }) { + my $this_object = shift @{ $object_row }; + my $input_sth = "select exp_id,warp_id,dateobs,rawExp.comment,warpRun.state AS warp_state,camProcessedExp.quality FROM "; + $input_sth .= " rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) LEFT JOIN camProcessedExp USING(cam_id) LEFT JOIN fakeRun USING (cam_id) LEFT JOIN warpRun USING (fake_id) "; + $input_sth .= " WHERE chipRun.label = '$label' AND chipRun.data_group = '$data_group' AND rawExp.filter = '$filter' AND rawExp.object = '$this_object' "; + $input_sth .= " ORDER BY dateobs "; + + my $warps = $db->selectall_arrayref( $input_sth ); + + # Each comment should only appear once. Therefore, if we see it more than once, we assume the first is extra. + my %comment_hash = (); + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + my $this_quality = ${ $this_warp }[5]; + if ($this_quality != 0) { + print STDERR "diff_queue: excluding $this_exp_id for $this_object due to non-zero cam.quality $this_quality\n"; + } + else { + $comment_hash{$this_comment} = $this_exp_id; + } + } + # Exclude any warps that are not stored in the comment_hash. + my @keep_warps = (); + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + if ((exists($comment_hash{$this_comment}))&& + ($comment_hash{$this_comment} == $this_exp_id)) { + push @keep_warps, $this_warp; + } + else { + print STDERR "diff_queue: excluding $this_exp_id for $this_object due to not being an accepted comment string $this_comment\n"; + } + } + @{ $warps } = @keep_warps; + + # Exclude the last entry if we do not have an even number of warps. + if (($#{ $warps } + 1) % 2 != 0) { + print STDERR "diff_queue: Number of input warps to make diffs is not even for target $target and object $this_object! $#{ $warps } "; + if ($#{ $warps} + 1 == 1) { + print STDERR ": I can do no diffs with only one exposure.\n"; + next; + } + else { + my $rejected_warp = pop @{ $warps }; + my $rejected_exp_id = ${ $rejected_warp }[0]; + print STDERR ": Rejecting ${rejected_exp_id} to force visit count.\n"; + } + } + + while ($#{ $warps } > -1) { + # The array is sorted in pairs of input/template. + my $input_warp = shift @{ $warps }; + my $template_warp = shift @{ $warps }; + + my $input_exp_id = ${ $input_warp }[0]; + my $input_comment = ${ $input_warp }[3]; + + my $template_exp_id = ${ $template_warp }[0]; + my $template_comment = ${ $template_warp }[3]; + + my $input_warp_id = ${ $input_warp }[1]; + my $template_warp_id = ${ $template_warp }[1]; + + my $input_warp_state = ${ $input_warp }[4]; + my $template_warp_state = ${ $template_warp }[4]; + + my $input_warp_camQuality = ${ $input_warp }[5]; + my $template_warp_camQuality = ${ $template_warp }[5]; + + $Npotential++; + + unless (defined($input_warp_id) && defined($template_warp_id) && + ($input_warp_state eq 'full')&&($template_warp_state eq 'full')) { + print STDERR "Diff for this $date $target $input_exp_id $template_exp_id not fully processed ($input_warp_state $template_warp_state) ($input_warp_camQuality $template_warp_camQuality)\n"; + if (($input_warp_camQuality == 4007)||($template_warp_camQuality == 4007)) { + # This should now never be reached. + # CZW: Trigger backup plan here? Or simply set up framework? + print STDERR " ...but this is due to a camera stage astrometry quality\n"; + $Npotential--; + } + next; + } + + if (verify_uniqueness_diff($input_warp_id,$template_warp_id,$date,$target) != 0) { + $Nqueued++; + print STDERR "Diffs already queued for this $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment $template_comment\n"; + next; + } + else { + print STDERR "Preparing to diff $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment $template_comment\n"; + } + + my $cmd = "$difftool -dbname $dbname -definewarpwarp "; + $cmd .= "-input_label $label -template_label $label -good_frac 0.1 "; + $cmd .= "-backwards "; # Needed because difftool assumes a different date sorting. + $cmd .= "-set_workdir $workdir -set_dist_group $dist_group -set_data_group $data_group "; + $cmd .= " -simple -set_label $label -exp_id $input_exp_id -template_exp_id $template_exp_id "; +# $cmd .= " -pretend "; + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + + if (defined($pretend)) { + $cmd .= ' -pretend '; + } + if ($debug == 1) { + $cmd .= ' -pretend '; + print STDERR "diff_queue: $cmd\n"; + print STDERR " $input_warp_id $template_warp_id\n"; + } + + if (($debug == 0)&&(!defined($pretend))) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $cmd, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + $Nqueued++; + } + } + } + $metadata_out{nsDiffPotential} += $Npotential; + $metadata_out{nsDiffQueued} += $Nqueued; +# if (($metadata_out{nsDiffPotential} == $metadata_out{nsDiffQueued})&&($metadata_out{nsObservingState} eq 'END_OF_NIGHT')) { +# $metadata_out{nsDiffState} = 'FINISHED_DIFFS'; +# } + +} + +sub desperate_diff_singles { + my $date = shift; + my $target = shift; + my $filter = shift; + my $pretend = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + my $this_date = undef; + my $chunk_name = undef; + my ($year,$month,$day,$hour,$min,$sec); + + my $db = init_gpc_db(); + + my $obj_sth = "select DISTINCT rawExp.object from warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) "; + $obj_sth .= " WHERE warpRun.state = 'full' AND warpRun.label = '$label' AND warpRun.data_group = '$data_group' AND rawExp.filter = '$filter' ORDER BY rawExp.object"; + + my $object_ref = $db->selectall_arrayref( $obj_sth ); + + my $Npotential = 0; + my $Nqueued = 0; + + #Before considering making diffs, we should check if there are no issues with summit download and/or registration. + #summitExp has limited information, so see if the number of exps in rawExp and summitExp match up before most recent dateobs of chunk + #be careful here, since dateobs is not quite completely the same in both tables. Therefore, allow numbers to be off by 1 + my $timenow=DateTime->now; + $timenow->subtract(minutes => 15); + $timenow->set_time_zone("UTC"); + + my $dateinit = $timenow->ymd; + my $raw_sth = "select count(dateobs),MAX(dateobs) FROM rawExp WHERE exp_name LIKE 'o%' AND dateobs > '$dateinit' AND dateobs <= '$timenow' "; + my ($nrawexps,$rawdate) = $db->selectrow_array( $raw_sth ); + + my $summit_sth = "select count(dateobs),MAX(dateobs) FROM summitExp WHERE exp_name LIKE 'o%' AND dateobs > '$dateinit' AND dateobs <= '$timenow' "; + my ($nsummitexps,$summitdate) = $db->selectrow_array( $summit_sth ); + + my $summittimediff = 9999; + if(($rawdate)&&($summitdate)) { + $rawdate=~/^(\d{4})\-(\d{2})\-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/; + my $date1=DateTime->new(year=>$1,month=>$2,day=>$3,hour=>$4,minute=>$5,second=>$6,time_zone=>"UTC"); + + $summitdate=~/^(\d{4})\-(\d{2})\-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/; + my $date2=DateTime->new(year=>$1,month=>$2,day=>$3,hour=>$4,minute=>$5,second=>$6,time_zone=>"UTC"); + + my $difference=$date2->delta_ms($date1); + + $summittimediff=(($difference->hours)*60.) + ($difference->minutes) + (($difference->seconds)/60.); + } + + #Run some basic checks + my $noff = abs($nsummitexps-$nrawexps); + if (($summittimediff > 10.)||($noff >10)) { + if ($debug == 1) { + print STDERR "desp_diff_singles: No desperate diffs will be attempted, since the number of exps at the summit and in rawExp do not match ($nsummitexps $nrawexps), or the timestamps are off ($summittimediff)\n"; + } + return; + } + + foreach my $object_row (@{ $object_ref }) { + my $this_object = shift @{ $object_row }; + + my $input_sth = "select exp_id,warp_id,dateobs,rawExp.comment,warpRun.state AS warp_state,camProcessedExp.quality,substr(comment, 1, position(' ' in comment)) FROM "; + $input_sth .= " rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) LEFT JOIN camProcessedExp USING(cam_id) LEFT JOIN fakeRun USING (cam_id) LEFT JOIN warpRun USING (fake_id) "; + $input_sth .= " WHERE chipRun.label = '$label' AND chipRun.data_group = '$data_group' AND rawExp.filter = '$filter' AND rawExp.object = '$this_object' "; + $input_sth .= " ORDER BY dateobs "; + + my $warps = $db->selectall_arrayref( $input_sth ); + + # Each comment should only appear once. Therefore, if we see it more than once, we assume the first is extra. + my %comment_hash = (); + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + my $this_quality = ${ $this_warp }[5]; + if ($this_quality != 0) { + print STDERR "desp_diff_singles: excluding $this_exp_id for $this_object due to non-zero cam.quality $this_quality\n"; + } + else { + $comment_hash{$this_comment} = $this_exp_id; + } + } + # Exclude any warps that are not stored in the comment_hash. + my @keep_warps = (); + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + if ((exists($comment_hash{$this_comment}))&& + ($comment_hash{$this_comment} == $this_exp_id)) { + push @keep_warps, $this_warp; + $this_date = ${ $this_warp }[2]; + $chunk_name = ${ $this_warp }[6]; + } + else { + print STDERR "desp_diff_singles: excluding $this_exp_id for $this_object due to being rejected $this_comment\n"; + } + } + @{ $warps } = @keep_warps; + + #find the time of the most recent exposure in that chunk + my $input_chunk = "select max(dateobs) FROM rawExp WHERE substr(comment, 1, position(' ' in comment)) = '$chunk_name' AND filter = '$filter' "; + my $chunk = $db->selectall_arrayref( $input_chunk ); + foreach my $this_chunk (@{ $chunk }) { + $this_date = ${ $this_chunk }[0]; + } + + #compute and store some stats for potential on-the-fly desperate diffs + my $nwarps = ($#{ $warps } + 1); + my $timediff = 0; + my $now=DateTime->now; + $now->set_time_zone("UTC"); + + if($this_date) { + if($this_date=~/^(\d{4})\-(\d{2})\-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/) { + my $dt=DateTime->new(year=>$1,month=>$2,day=>$3,hour=>$4,minute=>$5,second=>$6,time_zone=>"UTC"); + my $difference=$now->delta_ms($dt); + $timediff=($difference->hours) + (($difference->minutes) + ($difference->seconds)/60.)/60.; + } + } + + #Consider the special case of on-the-fly desperate diffs + #The conditions are: uneven nr of warps greater than 3, and the most recent observations is more than $desdiffdt hours old + if (($nwarps % 2 != 0) && ($nwarps >= 3) && ($timediff < $desdiffdt)) { + print STDERR "desp_diff_singles: There are potential desperate diffs to be done, but the time criterium is not met.\n"; + next; + } + if (($nwarps % 2 == 0) || ($nwarps == 1) || ($timediff < $desdiffdt)) { + next; + } + + # We are attempting to do the missing diffs, so reverse the list of retained warps. + # Good objects with all visits will be skipped due to the duplicate check. + # Bad objects will have the earliest visit rejected, and the visits repaired in a way that will produce all desired pairs. + @{ $warps } = reverse @keep_warps; + + # Exclude the last entry if we do not have an even number of warps. + if (($#{ $warps } + 1) % 2 != 0) { + print STDERR "desp_diff_singles: Number of input warps to make diffs is not even for target $target and object $this_object!"; + my $rejected_warp = pop @{ $warps }; + my $rejected_exp_id = ${ $rejected_warp }[0]; + print STDERR ": Rejecting ${rejected_exp_id} to force visit count.\n"; + } + + while ($#{ $warps } > -1) { + # The array is sorted in pairs of input/template. + my $template_warp = shift @{ $warps }; + my $input_warp = shift @{ $warps }; + + my $input_exp_id = ${ $input_warp }[0]; + my $input_comment = ${ $input_warp }[3]; + + my $template_exp_id = ${ $template_warp }[0]; + my $template_comment = ${ $template_warp }[3]; + + my $input_warp_id = ${ $input_warp }[1]; + my $template_warp_id = ${ $template_warp }[1]; + + my $input_warp_state = ${ $input_warp }[4]; + my $template_warp_state = ${ $template_warp }[4]; + + my $input_warp_camQuality = ${ $input_warp }[5]; + my $template_warp_camQuality = ${ $template_warp }[5]; + + $Npotential++; + + unless (defined($input_warp_id) && defined($template_warp_id) && + ($input_warp_state eq 'full')&&($template_warp_state eq 'full')) { + print STDERR "Desp diff for this $date $target $input_exp_id $template_exp_id not fully processed ($input_warp_state $template_warp_state) ($input_warp_camQuality $template_warp_camQuality)\n"; + if (($input_warp_camQuality == 4007)||($template_warp_camQuality == 4007)) { + # This should now never be reached. + # CZW: Trigger backup plan here? Or simply set up framework? + print STDERR " ...but this is due to a camera stage astrometry quality\n"; + $Npotential--; + } + next; + } + + if (verify_uniqueness_diff($input_warp_id,$template_warp_id,$date,$target) != 0) { + $Nqueued++; + print STDERR "Desp diffs already queued for this $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment $template_comment\n"; + next; + } + else { + print STDERR "Preparing to diff $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment $template_comment\n"; + } + + my $cmd = "$difftool -dbname $dbname -definewarpwarp "; + $cmd .= "-input_label $label -template_label $label -good_frac 0.1 "; + $cmd .= "-backwards "; # Needed because difftool assumes a different date sorting. + $cmd .= "-rerun "; # Needed because we may have some diffs that already use some of the exposures + $cmd .= "-set_workdir $workdir -set_dist_group $dist_group -set_data_group $data_group "; + $cmd .= " -simple -set_label $label -exp_id $input_exp_id -template_exp_id $template_exp_id "; + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + + if (defined($pretend)) { + $cmd .= ' -pretend '; + } + if ($debug == 1) { + $cmd .= ' -pretend '; + print STDERR "desp_diff_singles: $cmd\n"; + print STDERR " $input_warp_id $template_warp_id\n"; + } + + if (($debug == 0)&&(!defined($pretend))) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $cmd, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + $Nqueued++; + } + } + } + $metadata_out{nsDiffPotential} += $Npotential; + $metadata_out{nsDiffQueued} += $Nqueued; +} + +sub desperate_diff_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + my $pretend = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + my ($year,$month,$day,$hour,$min,$sec); + + my $db = init_gpc_db(); + + my $obj_sth = "select DISTINCT rawExp.object from warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) "; + $obj_sth .= " WHERE warpRun.state = 'full' AND warpRun.label = '$label' AND warpRun.data_group = '$data_group' AND rawExp.filter = '$filter' ORDER BY rawExp.object"; + + my $object_ref = $db->selectall_arrayref( $obj_sth ); + + my $Npotential = 0; + my $Nqueued = 0; + + #Before considering making diffs, we should check if there are no issues with summit download and/or registration. + #summitExp has limited information, so see if the number of exps in rawExp and summitExp match up before most recent dateobs of chunk + #be careful here, since dateobs is not quite completely the same in both tables. Therefore, allow numbers to be off by 1 + my $timenow=DateTime->now; + $timenow->subtract(minutes => 15); + $timenow->set_time_zone("UTC"); + + my $dateinit = $timenow->ymd; + my $raw_sth = "select count(dateobs),MAX(dateobs) FROM rawExp WHERE exp_name LIKE 'o%' AND dateobs > '$dateinit' AND dateobs <= '$timenow' "; + my ($nrawexps,$rawdate) = $db->selectrow_array( $raw_sth ); + + my $summit_sth = "select count(dateobs),MAX(dateobs) FROM summitExp WHERE exp_name LIKE 'o%' AND dateobs > '$dateinit' AND dateobs <= '$timenow' "; + my ($nsummitexps,$summitdate) = $db->selectrow_array( $summit_sth ); + + my $summittimediff = 9999; + if(($rawdate)&&($summitdate)) { + $rawdate=~/^(\d{4})\-(\d{2})\-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/; + my $date1=DateTime->new(year=>$1,month=>$2,day=>$3,hour=>$4,minute=>$5,second=>$6,time_zone=>"UTC"); + + $summitdate=~/^(\d{4})\-(\d{2})\-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/; + my $date2=DateTime->new(year=>$1,month=>$2,day=>$3,hour=>$4,minute=>$5,second=>$6,time_zone=>"UTC"); + + my $difference=$date2->delta_ms($date1); + + $summittimediff=(($difference->hours)*60.) + ($difference->minutes) + (($difference->seconds)/60.); + } + + #Run some basic download/registration checks + my $noff = abs($nsummitexps-$nrawexps); + if (($summittimediff > 10.)||($noff >10)) { + if ($debug == 1) { + print STDERR "desp_diff_queue: No desperate diffs will be attempted, since the number of exps at the summit and in rawExp do not match ($nsummitexps $nrawexps), or the timestamps are off ($summittimediff)\n"; + } + return; + } + + foreach my $object_row (@{ $object_ref }) { + my $this_object = shift @{ $object_row }; + + my $input_sth = "select exp_id,warp_id,dateobs,rawExp.comment,warpRun.state AS warp_state,camProcessedExp.quality FROM "; + $input_sth .= " rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) LEFT JOIN camProcessedExp USING(cam_id) LEFT JOIN fakeRun USING (cam_id) LEFT JOIN warpRun USING (fake_id) "; + $input_sth .= " WHERE chipRun.label = '$label' AND chipRun.data_group = '$data_group' AND rawExp.filter = '$filter' AND rawExp.object = '$this_object' "; + $input_sth .= " ORDER BY dateobs "; + + my $warps = $db->selectall_arrayref( $input_sth ); + + # Each comment should only appear once. Therefore, if we see it more than once, we assume the first is extra. + my %comment_hash = (); + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + my $this_quality = ${ $this_warp }[5]; + if ($this_quality != 0) { + print STDERR "desp_diff_queue: excluding $this_exp_id for $this_object due to non-zero cam.quality $this_quality\n"; + } + else { + $comment_hash{$this_comment} = $this_exp_id; + } + } + # Exclude any warps that are not stored in the comment_hash. + my @keep_warps = (); + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + if ((exists($comment_hash{$this_comment}))&& + ($comment_hash{$this_comment} == $this_exp_id)) { + push @keep_warps, $this_warp; + } + else { + print STDERR "desp_diff_queue: excluding $this_exp_id for $this_object due to not being an accepted comment string $this_comment\n"; + } + } + # We are attempting to do the missing diffs, so reverse the list of retained warps. + # Good objects with all visits will be skipped due to the duplicate check. + # Bad objects will have the earliest visit rejected, and the visits repaired in a way that will produce all desired pairs. + @{ $warps } = reverse @keep_warps; + + # Exclude the last entry if we do not have an even number of warps. + if (($#{ $warps } + 1) % 2 != 0) { + print STDERR "desp_diff_queue: Number of input warps to make diffs is not even for target $target and object $this_object! $#{ $warps } "; + if ($#{ $warps} + 1 == 1) { + print STDERR ": I can do no diffs with only one exposure.\n"; + next; + } + else { + my $rejected_warp = pop @{ $warps }; + my $rejected_exp_id = ${ $rejected_warp }[0]; + print STDERR ": Rejecting ${rejected_exp_id} to force visit count.\n"; + } + } + + while ($#{ $warps } > -1) { + # In this mode, the array is sorted in pairs of template/input, counter to the standard queue. + my $template_warp = shift @{ $warps }; + my $input_warp = shift @{ $warps }; + + my $input_exp_id = ${ $input_warp }[0]; + my $input_comment = ${ $input_warp }[3]; + + my $template_exp_id = ${ $template_warp }[0]; + my $template_comment = ${ $template_warp }[3]; + + my $input_warp_id = ${ $input_warp }[1]; + my $template_warp_id = ${ $template_warp }[1]; + + my $input_warp_state = ${ $input_warp }[4]; + my $template_warp_state = ${ $template_warp }[4]; + + my $input_warp_camQuality = ${ $input_warp }[5]; + my $template_warp_camQuality = ${ $template_warp }[5]; + + $Npotential++; + + unless (defined($input_warp_id) && defined($template_warp_id) && + ($input_warp_state eq 'full')&&($template_warp_state eq 'full')) { + print STDERR "Diff for this $date $target $input_exp_id $template_exp_id not fully processed ($input_warp_state $template_warp_state) ($input_warp_camQuality $template_warp_camQuality)\n"; + if (($input_warp_camQuality == 4007)||($template_warp_camQuality == 4007)) { + # This should now never be reached. + # CZW: Trigger backup plan here? Or simply set up framework? + print STDERR " ...but this is due to a camera stage astrometry quality\n"; + $Npotential--; + } + next; + } + + if (verify_uniqueness_diff($input_warp_id,$template_warp_id,$date,$target) != 0) { + $Nqueued++; + print STDERR "Diffs already queued for this $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment $template_comment\n"; + next; + } + else { + print STDERR "Preparing to diff $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment $template_comment\n"; + } + + my $cmd = "$difftool -dbname $dbname -definewarpwarp "; + $cmd .= "-input_label $label -template_label $label -good_frac 0.1 "; + $cmd .= "-backwards "; # Needed because difftool assumes a different date sorting. + $cmd .= "-rerun "; # Needed because we may have some diffs that already use some of the exposures + $cmd .= "-set_workdir $workdir -set_dist_group $dist_group -set_data_group $data_group "; + $cmd .= " -simple -set_label $label -exp_id $input_exp_id -template_exp_id $template_exp_id "; +# $cmd .= " -pretend "; + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + + if (defined($pretend)) { + $cmd .= ' -pretend '; + } + if ($debug == 1) { + $cmd .= ' -pretend '; + print STDERR "desp_diff_queue: $cmd\n"; + print STDERR " $input_warp_id $template_warp_id\n"; + } + + if (($debug == 0)&&(!defined($pretend))) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $cmd, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + $Nqueued++; + } + } + } + $metadata_out{nsDiffPotential} += $Npotential; + $metadata_out{nsDiffQueued} += $Nqueued; +# if (($metadata_out{nsDiffPotential} == $metadata_out{nsDiffQueued})&&($metadata_out{nsObservingState} eq 'END_OF_NIGHT')) { +# $metadata_out{nsDiffState} = 'FINISHED_DIFFS'; +# } + +} + + +sub multi_date_diff_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + my $pretend = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $db = init_gpc_db(); + + my $obj_sth = "select DISTINCT rawExp.object from warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) "; + $obj_sth .= " WHERE warpRun.state = 'full' AND warpRun.label = '$label' AND rawExp.filter = '$filter' ORDER BY rawExp.object"; + + my $object_ref = $db->selectall_arrayref( $obj_sth ); + + my $Npotential = 0; + my $Nqueued = 0; + + foreach my $object_row (@{ $object_ref }) { + my $this_object = shift @{ $object_row }; +# my $input_sth = "select exp_id,warp_id,dateobs,rawExp.comment from warpRun JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN chipRun USING(chip_id) JOIN rawExp USING(exp_id) "; +# $input_sth .= " WHERE warpRun.state = 'full' AND warpRun.label = '$label' AND warpRun.data_group = '$data_group' AND rawExp.filter = '$filter' AND rawExp.object = '$this_object' "; +# $input_sth .= " ORDER BY dateobs "; + + my $input_sth = "select exp_id,warp_id,dateobs,rawExp.comment,warpRun.state AS warp_state FROM "; + $input_sth .= " rawExp LEFT JOIN chipRun USING (exp_id) LEFT JOIN camRun USING (chip_id) LEFT JOIN fakeRun USING (cam_id) LEFT JOIN warpRun USING (fake_id) "; + $input_sth .= " WHERE warpRun.label = '$label' AND warpRun.data_group = '$data_group' AND rawExp.filter = '$filter' AND rawExp.object = '$this_object' "; + $input_sth .= " ORDER BY dateobs "; + + my $warps = $db->selectall_arrayref( $input_sth ); + + # Each comment should only appear once. Therefore, if we see it more than once, we assume the first is extra. + my %comment_hash = (); + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + $comment_hash{$this_comment} = $this_exp_id; + } + + if (($#{ $warps } + 1) % 2 != 0) { + print STDERR "md_diff_queue: Number of input warps to make diffs is not even for target $target and object $this_object! $#{ $warps } "; + if ($#{ $warps} + 1 == 1) { + print STDERR ": I can do no diffs with only one exposure.\n"; + next; + } + else { + print STDERR ": I should declare an exposure to be faulty.\n"; + my @keep_warps = (); +# print "@{ $warps }\n"; + foreach my $this_warp (@{ $warps }) { + my $this_comment = ${ $this_warp }[3]; + my $this_exp_id = ${ $this_warp }[0]; + if ($comment_hash{$this_comment} == $this_exp_id) { + push @keep_warps, $this_warp; + } + else { + print STDERR "md_diff_queue: excluding $this_exp_id for $this_object\n"; + } + } + @{ $warps } = @keep_warps; +# print "@{ $warps }\n"; + } + } + + while ($#{ $warps } > -1) { + my $input_warp = shift @{ $warps }; + my $input_exp_id = ${ $input_warp }[0]; + my $input_comment = ${ $input_warp }[3]; + + + my $template_warp = shift @{ $warps }; + + my $template_exp_id = ${ $template_warp }[0]; + + my $input_warp_id = ${ $input_warp }[1]; + my $template_warp_id = ${ $template_warp }[1]; + + my $input_warp_state = ${ $input_warp }[4]; + my $template_warp_state = ${ $template_warp }[4]; + + unless(defined($template_warp)&& defined($template_exp_id)) { + print STDERR "md_diff received an undef! $input_exp_id $input_comment $this_object T: $template_warp V: @$template_warp\n"; + next; + } + $Npotential++; + + unless (defined($input_warp_id) && defined($template_warp_id) && + ($input_warp_state eq 'full')&&($template_warp_state eq 'full')) { + print STDERR "md_Diff for this $date $target $input_exp_id ($input_warp_id $input_warp_state) $template_exp_id ($template_warp_id $template_warp_state) not fully processed\n"; + next; + } + + if (multi_date_verify_uniqueness_diff($input_warp_id,$template_warp_id,$date,$target) != 0) { + $Nqueued++; + print STDERR "md_Diffs already queued for this $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment\n"; + next; + } + + my $new_data_group = "${data_group}.multi"; + my $cmd = "$difftool -dbname $dbname -definewarpwarp "; + $cmd .= "-input_label $label -template_label $label -good_frac 0.1 "; + $cmd .= "-backwards "; # Needed because difftool assumes a different date sorting. + $cmd .= "-set_workdir $workdir -set_dist_group $dist_group -set_data_group $new_data_group "; + $cmd .= " -simple -set_label $label -exp_id $input_exp_id -template_exp_id $template_exp_id "; + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + +# $cmd .= " -pretend "; + if (defined($pretend)) { + $cmd .= ' -pretend '; + } + if ($debug == 1) { + $cmd .= ' -pretend '; + print STDERR "md_Diffs would like to queue for this $date $target $input_exp_id $template_exp_id ($input_warp_id $template_warp_id) $this_object $input_comment\n"; + print STDERR "md_diff_queue: $cmd\n"; + print STDERR " $input_warp_id $template_warp_id\n"; + } + + if (($debug == 0)&&(!defined($pretend))) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $cmd, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + $Nqueued++; + } + } + } + $metadata_out{nsDiffPotential} += $Npotential; + $metadata_out{nsDiffQueued} += $Nqueued; +# if (($metadata_out{nsDiffPotential} == $metadata_out{nsDiffQueued})&&($metadata_out{nsObservingState} eq 'END_OF_NIGHT')) { +# $metadata_out{nsDiffState} = 'FINISHED_DIFFS'; +# } + +} + +sub offnight_diff_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + my $pretend = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + + my $db = init_gpc_db(); + +# my $Npotential = 0; +# my $Nqueued = 0; + + my ($lunation_start,$lunation_end) = get_lunation_extent($date); + + +# Get a list of exposures that could be diffed + my $new_data_group = "${data_group}.offnight"; + my $new_dist_group = "${dist_group}.offnight"; + my $check_cmd = "$difftool -dbname $dbname -definewarpwarp "; + $check_cmd .= "-input_label $label -template_label $label -good_frac 0.1 "; + $check_cmd .= "-set_workdir $workdir -set_dist_group $new_dist_group -set_data_group $new_data_group "; + $check_cmd .= " -mintimediff 40000 "; + $check_cmd .= " -pretend -simple -rerun -set_label $label -filter $filter "; + $check_cmd .= " -dateobs_begin ${lunation_start}T00:00:00 -dateobs_end ${lunation_end}T23:59:59 -distance 1.5 "; + if (defined($reduction)) { + $check_cmd .= " -set_reduction $reduction "; + } + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $check_cmd, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + + # Parse results + my $diffs = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from difftool -definewarpwarp", 0, 0, $date, $PS_EXIT_PROG_ERROR); + foreach my $diff (@$diffs) { + unless (multi_date_verify_uniqueness_diff($diff->{input_warp_id},$diff->{template_warp_id},$date,$target)) { + # If we don't already have a diff with these inputs, make a diff with these inputs. + my $cmd = "$difftool -dbname $dbname -definewarpwarp -good_frac 0.1 "; + $cmd .= "-input_label $label -template_label $label "; + $cmd .= "-warp_id $diff->{input_warp_id} -template_warp_id $diff->{template_warp_id} "; + $cmd .= "-set_workdir $workdir -set_dist_group $new_dist_group -set_data_group $new_data_group "; + $cmd .= " -mintimediff 40000 "; + $cmd .= " -simple -rerun -set_label $label -filter $filter "; + $cmd .= " -dateobs_begin ${lunation_start}T00:00:00 -dateobs_end ${lunation_end}T23:59:59 -distance 1.5 "; + if (defined($reduction)) { + $cmd .= " -set_reduction $reduction "; + } + + if (defined($pretend)) { + $cmd .= ' -pretend '; + } + print STDERR "ON_diffs wants to run this command: $cmd\n"; + + if (($debug == 0)&&(!defined($pretend))) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $cmd, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + } + } + } +} + +sub intranight_WS_diff_queue { + my $date = shift; + my $target = shift; + my $filter = shift; + my $pretend = shift; + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($date,$target); + my $db = init_gpc_db(); + + my ($stacks_to_finish,$stacks_total) = check_stack_count($label); + if (($stacks_to_finish == 0)&&($stacks_total != 0)) { + my $cmd = "$difftool -dbname $dbname -definewarpstack "; + $cmd .= " -good_frac 0.2 "; + $cmd .= " -warp_label $label -stack_label $label -set_label $label "; + $cmd .= " -set_workdir $workdir -available -set_reduction WARPSTACK -set_dist_group $dist_group "; + $cmd .= " -rerun "; + } +} + +sub check_stack_count { + my $label = shift; + + my $stacks_to_finish = 0; + my $stacks_total = 0; + + my $sth = "SELECT DISTINCT stack_id from stackRun where label = '$label' AND state = 'new'"; + my $data_ref = $db->selectall_arrayref( $sth ); + $stacks_to_finish = $#{ $data_ref } + 1; + + $sth = "SELECT DISTINCT stack_id from stackRun where label = '$label'"; + $data_ref = $db->selectall_arrayref( $sth ); + $stacks_total = $#{ $data_ref } + 1; + return($stacks_to_finish,$stacks_total); +} + + +# +# Auto-Clean +################################################################################ + +sub construct_cleantool_args { + my $date = shift; + my $target = shift; + my $mode = shift; + + my $command = $clean_config{$mode}{COMMAND}; + my $retention_time; + if (exists($science_config{$target}{$mode})) { + $retention_time = $science_config{$target}{$mode}; + } + else { + $retention_time = $clean_config{$mode}{RETENTION_TIME}; + } + if ($retention_time <= 0) { + return("no clean","true"); + } + + my ($year,$month,$day) = split /-/,$date; + my $dt = DateTime->new(year => $year, month => $month, day => $day, + hour => 0, minute => 0, second => 0, nanosecond => 0, + time_zone => 'Pacific/Honolulu'); + + $dt->subtract(days => $retention_time); + my $cleaning_date = $dt->ymd; + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) = get_tool_parameters($cleaning_date,$target); + + $command =~ s/\@DBNAME\@/$dbname/; + $command =~ s/\@LABEL\@/$label/; + $command =~ s/\@WORKDIR\@/$workdir/; + $command =~ s/\@OBSMODE\@/$obs_mode/; + $command =~ s/\@OBJECT\@/$object/; + $command =~ s/\@TESS_ID\@/$tess_id/; + $command =~ s/\@DIST_GROUP\@/$dist_group/; + $command =~ s/\@DATA_GROUP\@/$data_group/; + $command =~ s/\@REDUCTION\@/$reduction/; + $command =~ s/\@CURRENT_DATE\@/$cleaning_date/; + + if ($debug == 1) { + $command .= ' -pretend '; + } + return($cleaning_date,$command); +} + +sub execute_cleans { + my $date = shift; + my $pretend = shift; + + foreach my $mode (sort (keys %clean_config)) { + foreach my $target (sort (keys %science_config)) { + if (exists($science_config{$target}{NOCLEAN})) { + next; + } + my ($cleaning_date,$command) = construct_cleantool_args($date,$target,$mode); + + if ($cleaning_date eq 'no clean') { + next; + } + print STDERR "$command\n"; + if (!(defined($pretend) || $debug == 1)) { +# print STDERR "BEAR IS DRIVING!?\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform cleantool ($command): $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + add_to_macro_list('clean_old',1,$date,$target,$mode); + } + if ($mode eq 'DIFF') { + my $WS_command = $command; + $WS_command =~ s/$target/${target}.WS/; + print STDERR "$WS_command\n"; + if (!(defined($pretend) || $debug == 1)) { + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $WS_command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform cleantool ($WS_command): $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + } + } + + } + } + return(0); +} + +# +# Utilities +################################################################################ + +sub get_observing_state { + my $date = shift; + my $eon_dt = DateTime->new( year => $datetime->year, + month => $datetime->month, + day => $datetime->day, + hour => 17, # 7, + minute => 30, + second => 0, + time_zone => 'UTC'); + + foreach my $eon (keys %eon_config) { + my $command = "$regtool -processedexp -simple "; + $command .= " -dbname $dbname "; + $command .= " -dateobs_begin ${date}T00:00:00 -dateobs_end ${date}T23:59:59 "; + $command .= " -object $eon_config{$eon}{OBJECT} " if defined($eon_config{$eon}{OBJECT}); + $command .= " -obs_mode $eon_config{$eon}{OBSMODE} " if defined($eon_config{$eon}{OBSMODE}); + $command .= " -exp_type $eon_config{$eon}{EXPTYPE} " if defined($eon_config{$eon}{EXPTYPE}); + $command .= " -comment $eon_config{$eon}{COMMENT} " if defined($eon_config{$eon}{COMMENT}); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform regtool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + my @eon_exposures = split /\n/, (join '', @$stdout_buf); + if ($#eon_exposures >= 0) { + return("END_OF_NIGHT"); + } + } + if ($force_registration) { + return("END_OF_NIGHT"); + } +# print "$now $eon_dt " . DateTime->compare($now,$eon_dt) . "\n"; + if (DateTime->compare($now,$eon_dt) < 1) { + return("OBSERVING"); + } + else { + return("END_OF_NIGHT"); + } +} + +# This basically does the end of night check, but does it "the hard way," to prevent the time from fooling us. +sub get_registration_state { + my $date = shift; + + foreach my $eon (keys %eon_config) { + my $command = "$regtool -processedexp -simple "; + $command .= " -dbname $dbname "; + $command .= " -dateobs_begin ${date}T00:00:00 -dateobs_end ${date}T23:59:59 "; + $command .= " -object $eon_config{$eon}{OBJECT} " if defined($eon_config{$eon}{OBJECT}); + $command .= " -obs_mode $eon_config{$eon}{OBSMODE} " if defined($eon_config{$eon}{OBSMODE}); + $command .= " -exp_type $eon_config{$eon}{EXPTYPE} " if defined($eon_config{$eon}{EXPTYPE}); + $command .= " -comment $eon_config{$eon}{COMMENT} " if defined($eon_config{$eon}{COMMENT}); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $command, verbose => $verbose ); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform regtool: $error_code", 0,0,$date, $PS_EXIT_SYS_ERROR); + } + my @eon_exposures = split /\n/, (join '', @$stdout_buf); + if ($#eon_exposures >= 0) { + return("REGISTERED"); + } + } + return("NOT_REGISTERED"); +} + + + +sub get_tool_parameters { + my $date = shift; + my $target = shift; + my $workdir_date = $date; $workdir_date =~ s%-%/%g; + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $label = "${target}.nightlyscience"; + my $workdir = "neb://\@HOST\@.0/${dbname}/${target}.nt/${workdir_date}"; + my $obs_mode = $science_config{$target}{OBSMODE}; + my $object = $science_config{$target}{OBJECT}; + my $comment = $science_config{$target}{COMMENT}; + my $dist_group = $science_config{$target}{DISTRIBUTION}; + my $data_group = "${target}.${trunc_date}"; + my $tess_id = $science_config{$target}{TESS}; + my $reduction = $science_config{$target}{REDUCTION}; + return($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction); +} + +sub get_dettool_parameters { + my $date = shift; + my $target = shift; + my $workdir_date = $date; $workdir_date =~ s%-%/%g; + my $trunc_date = $date; $trunc_date =~ s/-//g; + + my $exp_type = $detrend_config{$target}{EXPTYPE}; + my $det_type = $detrend_config{$target}{DETTYPE}; + my $ref_det_id = $detrend_config{$target}{REF_ID}; + my $ref_iter = $detrend_config{$target}{REF_ITER}; + my $maxN = $detrend_config{$target}{MAX_EXP}; + my $det_filter = $detrend_config{$target}{DET_FILTER}; + my $internal_filter; + if (defined($det_filter)) { + $internal_filter = $det_filter; $internal_filter =~ s/\..*//; + $internal_filter = '.' . $internal_filter; + } + else { + $internal_filter = ''; + } + unless (defined($maxN)) { + $maxN = 0; + } + my $lc_type = lc($exp_type); + my $label = "${lc_type}${internal_filter}.$trunc_date"; + my $workdir = 'neb://@HOST@.0/' . $dbname . "/detverify.nt/${workdir_date}/${lc_type}${internal_filter}"; + return($label,$workdir,$det_filter,$exp_type,$det_type,$ref_det_id,$ref_iter,$maxN); +} + +sub add_to_macro_list { + my $proc_mode = shift; + my $do_or_do_not = shift; + my $date = shift; + my $target = shift; + my $mode = shift; + + if ((defined($macro_config{$proc_mode}))&&($do_or_do_not)) { + unless (defined($metadata_out{N_MACROS})) { + $metadata_out{N_MACROS} = 0; + } + my $N = $metadata_out{N_MACROS}; + $metadata_out{"ns${N}Macro"} = $macro_config{$proc_mode}; + if ($debug == 1) { + print STDERR "WORKING ON A MACRO: ns${N}Macro $proc_mode $macro_config{$proc_mode}\n"; + } + if (defined($date)&&(defined($target))) { + + my ($label,$workdir,$obs_mode,$object,$comment,$tess_id,$dist_group,$data_group,$reduction) + = get_tool_parameters($date,$target); + $metadata_out{"ns${N}Macro"} =~ s/\@LABEL\@/$label/; + $metadata_out{"ns${N}Macro"} =~ s/\@WORKDIR\@/$workdir/; + $metadata_out{"ns${N}Macro"} =~ s/\@OBSMODE\@/$obs_mode/; + $metadata_out{"ns${N}Macro"} =~ s/\@OBJECT\@/$object/; + $metadata_out{"ns${N}Macro"} =~ s/\@COMMENT\@/$comment/; + $metadata_out{"ns${N}Macro"} =~ s/\@TESS_ID\@/$tess_id/; + $metadata_out{"ns${N}Macro"} =~ s/\@DIST_GROUP\@/$dist_group/; + $metadata_out{"ns${N}Macro"} =~ s/\@DATA_GROUP\@/$data_group/; + $metadata_out{"ns${N}Macro"} =~ s/\@REDUCTION\@/$reduction/; + } + if (defined($mode)) { + $metadata_out{"ns${N}Macro"} =~ s/\@EXTRA\@/$mode/; + } + if (defined($date)) { + $metadata_out{"ns${N}Macro"} =~ s/\@DATE\@/$date/; + } + if ($debug == 1) { + print STDERR "DONE WITH A MACRO: ns${N}Macro $proc_mode $macro_config{$proc_mode}\n"; + } + $metadata_out{N_MACROS} ++; + } +} + +sub init_gpc_db { + ## change to use the siteConfig setting, while readonly probably do not want to use a readonly replicated DB incase it gets behind + my $dbserver = metadataLookupStr($siteConfig, 'DBSERVER'); + my $dbuser = metadataLookupStr($ipprc->{_siteConfig}, "RO_DBUSER"); + my $dbpass = metadataLookupStr($ipprc->{_siteConfig}, "RO_DBPASSWORD"); + die "database configuration not set up" unless defined($dbserver); + die "database configuration not set up" unless defined($dbuser); + die "database configuration not set up" unless defined($dbpass); + #my $dbserver = 'ippdb01'; + #my $dbuser = 'ippuser'; + #my $dbpass = 'ippuser'; + use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock'; + $db = DBI->connect("DBI:mysql:database=${dbname};host=${dbserver};" . + "mysql_socket=" . DB_SOCKET(), + ${dbuser},${dbpass}, + { RaiseError => 1, AutoCommit => 1} + ) or die "Unable to connect to database $DBI::errstr\n"; + return($db); +} + +sub return_metadata { + my $date = shift; + print STDOUT "autoStack MULTI\n\n"; + print STDOUT "autoStack METADATA\n"; + print STDOUT " key STR ${date}-${dbname}\n"; + print STDOUT " date STR $date\n"; + + foreach my $k (sort(keys %metadata_out)) { + print STDOUT " $k STR $metadata_out{$k}\n"; + } + print STDOUT "END\n"; +} + +sub my_die { + my $msg = shift; # Warning message on die + my $stage = shift; # stage name + my $stage_id = shift; # identifier + my $date = shift; + my $exit_code = shift; # Exit code + + carp($msg); + exit $exit_code; +} + +sub my_trace { + if ($debug == 1) { + foreach my $thing (@_) { + carp($thing); + } + } +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/permcheck.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/permcheck.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/permcheck.pl (revision 41105) @@ -0,0 +1,700 @@ +#!/usr/bin/env perl + +use strict; +use warnings FATAL => qw( all ); + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Nebulous::Client; + +use Getopt::Long qw( GetOptions :config auto_help auto_version ); +use Pod::Usage qw( pod2usage ); +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Digest::MD5; +use URI; + +my $missing_tools = 0; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $staticskytool = can_run('staticskytool') or (warn "Can't find staticskytool" and $missing_tools = 1); +my $fftool = can_run('fftool') or (warn "Can't find fftool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); + +my ($server,$dbname,$stage,$stage_id,$do_cull,$save_log); + +$server = $ENV{'NEB_SERVER'} unless $server; +# $dbname = 'gpc1'; +GetOptions( + 'server|s=s' => \$server, + 'dbname=s' => \$dbname, + 'stage=s' => \$stage, + 'stage_id|x=s' => \$stage_id, + 'save_log' => \$save_log, + 'cull' => \$do_cull, +) || pod2usage( 2 ); + +unless(defined($do_cull)) { + $do_cull = 0; +} + +# Option parsing +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --server", -exitval => 2 ) + unless $server; +pod2usage( -msg => "Required options: --dbname", -exitval => 2 ) + unless $dbname; +pod2usage( -msg => "Required options: --stage [camera|warp|stack|skycal]", -exitval => 2 ) + unless $stage; +pod2usage( -msg => "missing key", exitval => 2 ) + unless defined $stage_id; + +my $ipprc = PS::IPP::Config->new( "GPC1" ) or die "Could not create config object.\n"; + +if ($save_log) { + my $time = time(); + my $logDest = "neb://any/perm_check/${stage}/${stage}_${stage_id}"; + $ipprc->redirect_to_logfile($logDest) or die "Could not redirect output to logfile ${logDest}\n"; +} + + +# Global options: +## Define the configuration. Ideally, this would be retrieved from the nebulous +## database, but there are some issues with that (such as grouping the b nodes +## into a less restrictive "offsite" location). +my $do_ops = 1; +my $i; + +# Set up nebulous db interface +my $neb = Nebulous::Client->new( + proxy => "$server", +); +die "can't connected to Nebulous Server: $server" + unless defined $neb; + +## This new implementation is somewhat messy, but is more general and adaptable. +## First, we set up a requirement mapping, explaining where we want copies, and +## how many copies we want at each site. +my %requirement_map = (); +$requirement_map{ITC} = 1; +$requirement_map{OFFSITE} = 0; +$requirement_map{MRTCB} = 1; + +## Second, construct a list of volumes, mapped to their site location, using the +## same site locations as in the requirement map. +my %volume_map = (); +for ($i = 4; $i <= 21; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 23; $i <= 32; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 54; $i <= 97; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 100; $i <= 104; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; + $vol = sprintf("ipp%03d.1",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 105; $i <= 117; $i++) { +# if ($i == 115) { next; } + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'ITC'; + $vol = sprintf("ipp%03d.1",$i); + $volume_map{$vol} = 'ITC'; +} +for ($i = 118; $i <= 122; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; + $vol = sprintf("ipp%03d.1",$i); + $volume_map{$vol} = 'MRTCB'; +} + + +for ($i = 0; $i <= 15; $i++) { + my $loc = 'OFFSITE'; + if ($i == 6) { + $loc = 'MRTCB'; + } # This isn't "offsite", it's with the rest of the maui cluster. + if ($i == 9) { next; } # Not online + + my $vol = sprintf("ippb%02d.0",$i); + $volume_map{$vol} = $loc; + $vol = sprintf("ippb%02d.1",$i); + $volume_map{$vol} = $loc; + if ($i <= 6) { + $vol = sprintf("ippb%02d.2",$i); + $volume_map{$vol} = $loc; + } +} + +## Next, get disk space values, and check which hosts are listed as available. +my %acceptable_volume = (); +my $mounts = $neb->mounts(); +foreach my $vol_row (@$mounts) { + my ($mount_point, $total, $used, $vol_id, $name, $host, $path, $allocate, $available, $xattr) = @{ $vol_row }; + if (($allocate == 1)&&($available == 1)&&( $used / $total < 0.98)) { + $acceptable_volume{$name} = 1; + } + else { + print "## $name $allocate $available $used $total\n"; + $acceptable_volume{$name} = 0; + } + if ($name =~ /ippb05/) { + $acceptable_volume{$name} = 0; + } +# if (($name eq 'ipp106.0')||($name eq 'ipp106.1')) { +# $acceptable_volume{$name} = 0; +# } +} + +## Finally, generate lists containing which volumes are located at which site. +## This allows us to randomly select a volume from the list for the site that +## we plan on replicating to. +my %volume_lists = (); +foreach my $vol_key (keys %requirement_map) { + @{ $volume_lists{$vol_key} } = grep { $acceptable_volume{$_} == 1 } ( + grep { $volume_map{$_} eq $vol_key } (keys %volume_map) + ); + print "$vol_key " . join(' ', @{ $volume_lists{$vol_key} }) . "\n"; + + if ($#{ $volume_lists{$vol_key} } == -1) { + die "No acceptable volume found for site $vol_key!\n"; + } +} + +# Pull data from the gpc1 database +my $verbose = 0; +my $mdcParser = PS::IPP::Metadata::Config->new; + +# Not technically imfiles, but the nebulous check block already uses files as a variable. +my $imfiles; +if (($stage eq 'camera')||($stage eq 'cam')) { + $stage = 'camera'; + my $cmd = "$camtool -processedexp -cam_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); +} +elsif ($stage eq 'stack') { + my $cmd = "$stacktool -sumskyfile -stack_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); +} +elsif ($stage eq 'skycal') { + my $cmd = "$staticskytool -skycalresult -skycal_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); +} +elsif ($stage eq 'warp') { + my $cmd = "$warptool -warped -warp_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); +} +elsif ($stage eq 'ff') { + + my $cmd = "$fftool -summary -ff_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); +} +elsif ($stage eq 'diff') { + my $cmd = "$difftool -diffskyfile -diff_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); +} +elsif ($stage eq 'burntool') { + my $cmd = "$regtool -processedimfile -exp_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); +} + +my $timer_start = time(); +my $timer = time(); +my %components = ('camera' => ['PSASTRO.OUTPUT','PSASTRO.OUTPUT.MASK','PSPHOT.BACKMDL','PSPHOT.PSF.RAW.SAVE'], + 'warp' => ['PSWARP.OUTPUT','PSWARP.OUTPUT.MASK','PSWARP.OUTPUT.VARIANCE'], + 'stack' => ['PPSTACK.UNCONV.COMP','PPSTACK.UNCONV.MASK.COMP','PPSTACK.UNCONV.VARIANCE.COMP', + 'PPSTACK.UNCONV.EXP','PPSTACK.UNCONV.EXPNUM','PPSTACK.UNCONV.EXPWT.COMP','PPSTACK.TARGET.PSF'], + 'skycal' => ['PSASTRO.OUTPUT.CMF','PSPHOT.OUTPUT.CFF','PSPHOT.STACK.PSF.SAVE','PSPHOT.STACK.BACKMDL'], + 'ff' => ['PSPHOT.OUT.CMF.MEF','PSPHOT.OUTPUT.CFF','PSPHOT.FULLFORCE.OUTPUT','PSPHOT.PSF.SKY.SAVE'], + 'diff' => ['PPSUB.OUTPUT.SOURCES','PPSUB.INVERSE.SOURCES','PSPHOT.PSF.SKY.SAVE','PSPHOT.BACKMDL.MEF','PPSUB.OUTPUT.KERNELS'], + 'burntool' => ['BURN.TABLE.DOESNT.HAVE.A.PRODUCT'] + ); + +print "## permcheck.pl: $stage $stage_id $dbname $do_cull $do_ops $timer_start\n"; +foreach my $entry (@$imfiles) { + my $path_base = $entry->{path_base}; + my $data_state = $entry->{state}; + my $hostname = $entry->{hostname}; + my $quality = $entry->{quality}; + + # Fixes burntool issues. + unless(defined($path_base)) { + $path_base = 'NO_PB'; + } + unless(defined($data_state)) { + $data_state = $entry->{data_state}; + } + + $timer = time() - $timer_start; + print "# $path_base $data_state $hostname $quality T: $timer\n"; + if ($quality != 0) { next; } + + my @keys = (); + foreach my $product (@{ $components{$stage} }) { + print "# $product\n"; + my $is_done = 0; + if ($stage eq 'camera') { + if ($product eq 'PSASTRO.OUTPUT.MASK') { + my @otas = ('XY01','XY02','XY03','XY04','XY05','XY06', + 'XY10','XY11','XY12','XY13','XY14','XY15','XY16','XY17', + 'XY20','XY21','XY22','XY23','XY24','XY25','XY26','XY27', + 'XY30','XY31','XY32','XY33','XY34','XY35','XY36','XY37', + 'XY40','XY41','XY42','XY43','XY44','XY45','XY46','XY47', + 'XY50','XY51','XY52','XY53','XY54','XY55','XY56','XY57', + 'XY60','XY61','XY62','XY63','XY64','XY65','XY66','XY67', + 'XY71','XY72','XY73','XY74','XY75','XY76'); + foreach my $ota (@otas) { + push @keys, $ipprc->filename($product,$path_base,$ota); + } + $is_done = 1; + } + elsif (($product eq 'PSPHOT.BACKMDL')||($product eq 'PSPHOT.PSF.RAW.SAVE')) { + my $chip_id = $entry->{chip_id}; + my $chip_cmd = "$chiptool -processedimfile -chip_id $chip_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $chip_cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + my $chip_files = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); + + foreach my $chip_entry (@$chip_files) { + my $chip_path_base = $chip_entry->{path_base}; + my $class_id = $chip_entry->{class_id}; + push @keys, $ipprc->filename($product,$chip_path_base,$class_id); + } + $is_done = 1; + } + } + elsif ($stage eq 'ff') { + if ($product ne 'PSPHOT.FULLFORCE.OUTPUT') { + my $ffsum_cmd = "$fftool -result -ff_id $stage_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $ffsum_cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + my $ff_files = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); + + foreach my $ff_entry (@$ff_files) { + my $ff_path_base = $ff_entry->{path_base}; + my $ff_skycell = $ff_entry->{skycell_id}; + my $warp_id = $ff_entry->{warp_id}; + if ($product ne 'PSPHOT.PSF.SKY.SAVE') { + push @keys, $ipprc->filename($product,$ff_path_base); + } + else { + my $warptool_cmd = "$warptool -warped -skycell_id $ff_skycell -warp_id $warp_id -dbname $dbname"; + ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $warptool_cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + my $warp_files = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); + foreach my $wt_entry (@$warp_files) { + my $wt_quality = $wt_entry->{quality}; + if ($quality == 0) { + my $wt_path_base = $wt_entry->{path_base}; + push @keys, $ipprc->filename($product,$wt_path_base,$ff_skycell); + } + } + } + } + $is_done = 1; + } + } + elsif ($stage eq 'burntool') { + if ($product eq 'BURN.TABLE.DOESNT.HAVE.A.PRODUCT') { + my $bt_state = $entry->{burntool_state}; + if ($bt_state != -14) { next; } + my $bt_file = $entry->{uri}; + $bt_file =~ s/fits$/burn.tbl/; + push @keys, $bt_file; + + $is_done = 1; + } + + } + elsif ($stage eq 'skycal') { + if (($product eq 'PSPHOT.STACK.PSF.SAVE')||($product eq 'PSPHOT.STACK.BACKMDL')) { + my $sky_id = $entry->{sky_id}; + my $stack_id = $entry->{stack_id}; + + my $ss_cmd = "$staticskytool -result -sky_id $sky_id -dbname $dbname"; + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $ss_cmd, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stagetool: $error_code", $stage_id); + } + my $stack_files = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from stagetool", $stage_id); + foreach my $ss_entry (@$stack_files) { + my $ss_path_base = $ss_entry->{path_base}; + push @keys, $ipprc->filename($product,$ss_path_base,$stack_id); + } + $is_done = 1; + } + + } + + if ($is_done == 0) { + push @keys, $ipprc->filename($product,$path_base); +# print "$product\n"; +# print ">> " . $ipprc->filename($product,$path_base) . "\n"; + } +# Do validation + } + + $timer = time() - $timer_start; + + printf("# Identified %d : %s\n",$#keys + 1, $timer); + foreach my $key (@keys) { + # Testing code. +# print "$key\n"; +# next; +# } + + # neb-stat level handling + my $stat = $neb->stat($key); + unless ($stat) { + if (($stage eq 'camera')&&($key =~ /psf/)) { + warn "nebulous key: $key not found"; + } + elsif (($stage eq 'ff')&&($key =~ /cff/)) { + warn "nebulous key: $key not found"; + } + else { + die "nebulous key: $key not found"; + } + } + my $instances; + my $md5sum = ''; + +# # This needs to be in an eval, because although we expect things to exist, they +# # may not. This is a fatal error in rawcheck, but need not be here. + eval { + $instances = $neb->find_instances($key, 'any'); + }; + unless (defined($instances)) { print "## skipping due to zero instances\n"; next; } + die "no instances found" unless $instances; + + my $existing_copies = 0; + my $Ngood = 0; + my $Nbad = 0; + my %good_instances = (); + my %bad_instances = (); + + #unsafe + my $continue_checking_md5sums = 1; + my %good_instances_unchecked = (); + #end unsafe + + my @files = map {URI->new($_)->file if $_} @$instances; + my @validation = (); + + for (my $i = 0; $i <= $#files; $i++) { + my ($instance_exists,$instance_md5sum,$instance_host,$instance_volume,$instance_site, $is_good); + ($instance_host,$instance_volume) = parse_volume($files[$i]); + $instance_site = $volume_map{$instance_volume}; + $is_good = 0; + + if (-e $files[$i]) { + $instance_exists = 1; + $existing_copies++; + if ($continue_checking_md5sums == 1) { #unsafe + $instance_md5sum = local_md5sum($files[$i]); + + # This is bad, but I don't know what the right solution is. We don't have + # the md5sum a priori. I think this is also the only major change needed + # from rawcheck.pl + if (($md5sum eq '')&&($instance_md5sum ne 'd41d8cd98f00b204e9800998ecf8427e')) { + $md5sum = $instance_md5sum; + } + + if ($instance_md5sum eq $md5sum) { + push @{ $good_instances{$instance_site} }, $i; + $is_good = 1; + $Ngood++; + } + else { + push @{ $bad_instances{$instance_site} }, $i; + $Nbad++; + } + } #unsafe + else { #unsafe + $instance_md5sum = 'CHECKING_STOPPED'; + push @{ $good_instances_unchecked{$instance_site} }, $i; + $is_good = 1; + $Ngood++; + } #end unsafe + } + else { + $instance_exists = 0; + $instance_md5sum = 'NON-EXISTANT'; + push @{ $bad_instances{$instance_site} }, $i; + } + + $validation[$i] = sprintf(" % 3d %d %32s %s %s %s\n", + $instance_exists,$is_good,$instance_md5sum, + $files[$i],$instance_host,$instance_volume); + + #unsafe + # Remove this section when we decide to go back to actually checking everything + # to make sure we don't have any secret data corruption + if ($Ngood > 0) { + print "# Breaking from validation check, as a valid copy has been found.\n"; + $continue_checking_md5sums = 0; + } + #end unsafe + } + + $timer = time() - $timer_start; + # object_id ext_id epoch available existing total timer + printf("%s %s %s %d %d %d %d\n",@$stat[0],@$stat[1],@$stat[4],@$stat[6],$existing_copies,@$stat[7],$timer); + # instance_exists is_good instance_md5sum file instance_host instance_volume + my $val_string = join('',@validation); + print "$val_string"; + +# # Decide what to do + + if ($Ngood == 0) { + # If we have no copies, we can't do anything. + die "No valid instance of key: $key\n"; + } + ## We have more than zero bad copies. We may cull some of these in the future, but we should try to + ## leave everything in the best state possible. + printf(">> %d %d\n",$Ngood, $#files + 1); + if ($Nbad > 0) { + my $good_copy; + my $good_copy_index; + foreach my $site_key (keys %good_instances) { + if ($#{ $good_instances{$site_key} } != -1) { + $good_copy_index = $good_instances{$site_key}[0]; + $good_copy = $files[$good_copy_index]; + last; + } + } + printf(">> GOOD: $good_copy\n"); + foreach my $site_key (keys %bad_instances) { + foreach my $bad_copy_index (@{ $bad_instances{$site_key} }) { + print "cp $good_copy $files[$bad_copy_index]\n"; + if ($do_ops) { + system("cp $good_copy $files[$bad_copy_index]"); + } + my $tmpmd5 = local_md5sum($files[$bad_copy_index]); + if ($tmpmd5 ne $md5sum) { + ## This isn't super critical, so we don't need to die here. + warn "Post-repair md5sum does not match! $tmpmd5 != $md5sum: $files[$bad_copy_index]"; + } + else { + ## success + push @{ $good_instances{$site_key} }, $bad_copy_index; + } + } + } + ## We've done work here, so we can't do a cull this iteration. + if ($do_cull == 1) { $do_cull = -1; } + } + + #unsafe + foreach my $site_key (keys %good_instances_unchecked) { + push @{ $good_instances{$site_key} }, @{ $good_instances_unchecked{$site_key} }; + } + #end unsafe + + ## We can now attempt to make replicated copies to the sites that require additional copies. + foreach my $site_key (keys %requirement_map) { + my $have_instances = $#{ $good_instances{$site_key} } + 1; + print "## $site_key $have_instances $requirement_map{$site_key}\n"; + if ($#{ $good_instances{$site_key} } + 1 < $requirement_map{$site_key}) { + my $rep_vol = get_random_site_volume($site_key); + print "neb-replicate --volume $rep_vol $key\n"; + if ($do_ops) { + $neb->replicate($key,$rep_vol) or die "failed to replicate the single valid copy to the backup node"; + if ($@) { die $@; } + + # Begin my best validation thought + system("sync") == 0 or die "Couldn't sync?"; + my $uris = $neb->find_instances($key,$rep_vol); + @$uris = map {URI->new($_)->file if $_} @$uris; + my $tmpmd5 = local_md5sum(${ $uris }[0]); + + my $validation_str = sprintf("% 3d %d %32s %s %s %s", + -1,-1,$tmpmd5, + ${ $uris }[0],"repl",$rep_vol); + print + join("\n" . " " x 4, $validation_str), "\n"; + + if ($tmpmd5 ne $md5sum) { + die "Post-replication md5sum does not match! $tmpmd5 != $md5sum"; + } + # End my best validation thought. + } + ## We've done work here, so we can't do a cull this iteration. + if ($do_cull == 1) { $do_cull = -1; } + } + } + + ## Do culls if that's what we were going to do. + if ($do_cull == -1) { + die "Cull option passed, but files were modified in the scan/repair/replicate phase. Not running cull!\n"; + } + elsif ($do_cull == 1) { + ## At this point, we should have no files in the bad_instances lists, because we've repaired them. + foreach my $site_key (keys %good_instances) { + if ($#{ $good_instances{$site_key} } + 1 > $requirement_map{$site_key}) { + for ($i = $requirement_map{$site_key}; $i <= $#{ $good_instances{$site_key} }; $i++) { + my $cull_index = ${ $good_instances{$site_key} }[$i]; + my ($instance_host,$instance_volume) = parse_volume($files[$cull_index]); + print "neb-cull --volume $instance_volume $key\n"; + if ($do_ops) { + # The tilde here is to force hard volumes. Don't touch it. + # Also: the 2 is a "minimum number of copies" restriction. Let's not be crazy here. + $neb->cull($key,"~${instance_volume}",2) or die "failed to cull a superfluous instance"; + if ($@) { die "$@"; } + } + } # End loop over extra instances + } # End check for sites with extra instances + } # End loop over sites. + } # End cull + + } ## End loop over keys. +} ## Endd loop over stage components. + + +sub local_md5sum { + my $filename = shift; + my $volume = (split /\//, $filename)[2]; + my $host = $volume; + $host =~ s/\.\d//; +# print "$filename $host $volume\n"; + my $response; + my @file_stat = stat($filename); + if ($file_stat[7] > 1e7) { + $response = `ssh $host remote_md5sum.pl $filename`; + chomp($response); + } + else { + $response = $file_stat[7]; + } + my ($sum, undef) = split /\s+/, $response; + unless(defined($sum)) { + my_die("Failed to calculate md5sum locally. $filename $host $volume"); + } + return($sum); +} + +sub parse_volume { + my $filename = shift(@_); + my $full_volume = (split /\//, $filename)[2]; + my ($hostname,undef) = split /\./, $full_volume; # /; + return($hostname,$full_volume); +} + +sub get_random_site_volume { + my $site_key = shift(@_); + my $NN = scalar @{ $volume_lists{$site_key} }; + my $backup_volume = ${ $volume_lists{$site_key} }[int(rand($NN))]; + return($backup_volume); +} + +sub my_die { + my $msg = shift(@_); + print $msg . "\n"; + foreach my $a (@_) { + print "ARG: $a\n"; + } + die; +} + + + + + + + + + + + + + + + + + + + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/psphot_fullforce_summary.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/psphot_fullforce_summary.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/psphot_fullforce_summary.pl (revision 41105) @@ -0,0 +1,305 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $psphotFullForceSummary = can_run('psphotFullForceSummary') or (warn "Can't find psphotFullForceSummary" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $fftool = can_run('fftool') or (warn "Can't find fftool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($ff_id, $outroot, $reduction, $camera); +my ($dbname, $threads, $verbose, $save_temps, $no_update, $no_op, $redirect); + +GetOptions( + 'ff_id=s' => \$ff_id, + 'camera=s' => \$camera, # camera name of sources + 'dbname|d=s' => \$dbname, # Database name + 'threads=s' => \$threads, # Number of threads to use + 'outroot=s' => \$outroot, # Output root name + 'reduction=s' => \$reduction, # Reduction class + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --ff_id --outroot --camera", + -exitval => 3, + ) + unless defined $ff_id, + and defined $camera + and defined $outroot; + +my $ipprc = PS::IPP::Config->new($camera) or my_die( "Unable to set up", $ff_id, $PS_EXIT_CONFIG_ERROR ); + +my $neb; +my $scheme = file_scheme($outroot); +if ($scheme and $scheme eq 'neb') { + $neb = $ipprc->nebulous(); +} + +my $logDest = $ipprc->filename("LOG.EXP", $outroot); + +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", + $ff_id, $PS_EXIT_SYS_ERROR ) if $redirect; + + +my ($listFile, $listName) = tempfile("/tmp/fullforce.summary.list.XXXX", UNLINK => !$save_temps ); + +my $cff_file; + +{ + my $mdcParser = PS::IPP::Metadata::Config->new; + my $results; + { + my $command = "$fftool -result -ff_id $ff_id -quality 0"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform fftool -result $error_code", + $ff_id, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $ff_id, $PS_EXIT_PROG_ERROR); + $results = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $ff_id, $PS_EXIT_PROG_ERROR); + } + + &my_die("result list is empty.", $ff_id, $PS_EXIT_SYS_ERROR) + if scalar @$results == 0; + + print $listFile "SOURCES MULTI\n"; + foreach my $result (@$results) { + my $cmf = $ipprc->filename('PSPHOT.FULLFORCE.OUTPUT', $result->{path_base}); + &my_die("Couldn't find input cmf: $cmf", $ff_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($cmf); + print $listFile "SOURCES STR $cmf\n"; + if (!$cff_file) { + $cff_file = $ipprc->filename('PSPHOT.OUTPUT.CFF', $result->{sources_path_base}); + &my_die("Couldn't find input cff: $cff_file", $ff_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($cff_file); + } + } + close $listFile; +} + +&my_die("No CFF found in results: $cff_file", $ff_id, $PS_EXIT_PROG_ERROR) unless $cff_file; + + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_psphot = $ipprc->reduction($reduction, 'FULLFORCE_PSPHOT'); # Recipe to use for psphot +unless ($recipe_psphot) { + &my_die("Couldn't find selected reduction for PSPHOT: $reduction\n", + $ff_id, $PS_EXIT_CONFIG_ERROR); +} + +# XXX: need to figure out whether this works or not +# We probably want to create a specific recipe that looks at the results +my $recipe_ppstats = 'WARPSTATS'; +my $doStats = 0; + +print "reduction: $reduction\n"; +print "recipe_psphot: $recipe_psphot\n"; + +my $dump_config = 1; + +# Get the output filenames +my $outputSources = prepare_output("PSPHOT.FULLFORCE.OUTPUT", $outroot, 1); +my $configuration = prepare_output("PSPHOT.SKY.CONFIG", $outroot, 1) if $dump_config; +my $outputStats = prepare_output("SKYCELL.STATS", $outroot, 1) if $doStats; +my $traceDest = prepare_output("TRACE.EXP", $outroot, 1); + +my $cmdflags = ""; + +# Perform psphotFullForceSummary +{ + my $command = "$psphotFullForceSummary $outroot"; + $command .= " -input $listName"; + $command .= " -cff $cff_file"; + $command .= " -threads $threads" if defined $threads; + if ($dump_config) { + $command .= " -dumpconfig $configuration"; + } + $command .= " -recipe PSPHOT $recipe_psphot"; + if ($doStats) { + $command .= " -stats $outputStats"; + $command .= " -recipe PPSTATS $recipe_ppstats"; + } +# $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psphotFullForceSummary: $error_code", $ff_id, $error_code); + } + + # Stats: TODO + if ($doStats) { + check_output($outputStats, 1); + my $outputStatsReal = $ipprc->file_resolve($outputStats); + + # measure chip stats + $command = "$ppStatsFromMetadata $outputStatsReal - WARP_SKYCELL"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $ff_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + } + my ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + + if (!$quality) { + check_output($outputSources, 1); + } + } else { + print "Not executing: $command\n"; + } +} + +# Add the result to the database +{ + my $command = "$fftool -ff_id $ff_id"; + $command .= " -addsummary -path_base $outroot"; + $command .= " $cmdflags"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform fftool -addwarped" ; + &my_die("$err_message: $error_code", $ff_id, $error_code); + } + } else { + print "Not executing $command\n"; + } +} + +exit 0; + + +# Prepare to write to an output file +# Lookup the filename in the rules. +# Make sure that if file exists and is a nebulous file that there is only one instance +# Deal with files that have been lost. +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, undef, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $ff_id, $error); + return $output; +} + +sub check_output +{ + my $file = shift; + my $replicate = shift; + + if (!defined $file) { + return; + } + + &my_die("Couldn't find expected output file: $file", $ff_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($file); + + # Funpack to confirm we've really made things correctly + my $diskfile = $ipprc->file_resolve($file); + if ($diskfile =~ /fits/) { + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $ff_id, $PS_EXIT_SYS_ERROR); + my $check_command = "$funpack -S $diskfile > /dev/null"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $check_command, verbose => $verbose); + if (!$success) { + &my_die("Output file not a valid fits file: $file", $ff_id, $PS_EXIT_SYS_ERROR); + } + } + ##### + + if ($replicate and $neb) { + $ipprc->replicate_file($file) or &my_die("failed to replicate: $file\n", $ff_id, $PS_EXIT_SYS_ERROR); + } +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $ff_id = shift; # full force run identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $ff_id) { + my $command = "$fftool -ff_id $ff_id -fault $exit_code"; + $command .= " -addsummary"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -path_base $outroot" if defined $outroot; + $command .= " -dbname $dbname" if defined $dbname; + unless ($no_update) { + run(command => $command, verbose => $verbose); + } else { + print "not executing $command\n"; + } + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/psphot_fullforce_warp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/psphot_fullforce_warp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/psphot_fullforce_warp.pl (revision 41105) @@ -0,0 +1,330 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $psphotFullForce = can_run('psphotFullForce') or (warn "Can't find psphotFullForce" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $fftool = can_run('fftool') or (warn "Can't find fftool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($ff_id, $warp_id, $skycell_id, $path_base, $sourceroot, $camera); +my ($outroot, $reduction); +my ($dbname, $threads, $verbose, $no_update, $no_op, $redirect); + +GetOptions( + 'ff_id=s' => \$ff_id, + 'warp_id=s' => \$warp_id, # warp identifier + 'skycell_id=s' => \$skycell_id,# Skycell identifier + 'warp_path_base=s' => \$path_base, # path_base of the warp skycell + 'sources_path_base=s' => \$sourceroot,# path_base of sources + 'camera=s' => \$camera, # camera name of sources + 'dbname|d=s' => \$dbname, # Database name + 'threads=s' => \$threads, # Number of threads to use + 'outroot=s' => \$outroot, # Output root name + 'reduction=s' => \$reduction, # Reduction class + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --ff_id --warp_id --sourceroot --skycell_id --warp_path_base --outroot --camera", + -exitval => 3, + ) unless defined $ff_id, + and defined $sourceroot + and defined $path_base + and defined $warp_id + and defined $skycell_id + and defined $camera + and defined $outroot; + +my $ipprc = PS::IPP::Config->new($camera) or my_die( "Unable to set up", $ff_id, $warp_id, $skycell_id, $PS_EXIT_CONFIG_ERROR ); + +my $neb; +my $scheme = file_scheme($outroot); +if ($scheme and $scheme eq 'neb') { + $neb = $ipprc->nebulous(); +} + +my $logDest = $ipprc->filename("LOG.EXP", $outroot, $skycell_id); + +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", + $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +if (0) { +# if (!$path_base) { + # If path_base is not supplied, look it up in the database. + my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + my $files; + { + my $command = "$warptool -warped -warp_id $warp_id -skycell_id $skycell_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool -warpskyfile -inputskyfile: $error_code", + $ff_id, $warp_id, $skycell_id, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $ff_id, $warp_id, $skycell_id, $PS_EXIT_PROG_ERROR); + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $ff_id, $warp_id, $skycell_id, $PS_EXIT_PROG_ERROR); + } + + &my_die("Input list does not contain exactly one elements", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR) + unless scalar @$files == 1; + + my $warp = $files->[0]; + + $path_base = $warp->{path_base}; + &my_die("Couldn't find input path in warptool output", $ff_id, $warp_id, $skycell_id, $PS_EXIT_UNKNOWN_ERROR) + unless defined $path_base; + +} + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_psphot = $ipprc->reduction($reduction, 'FULLFORCE_PSPHOT'); # Recipe to use for psphot +unless ($recipe_psphot) { + &my_die("Couldn't find selected reduction for PSPHOT: $reduction\n", + $ff_id, $warp_id, $skycell_id, $PS_EXIT_CONFIG_ERROR); +} + +my $doStats = 1; + +print "reduction: $reduction\n"; +print "recipe_psphot: $recipe_psphot\n"; + +# use psf measured on input warp +# XXX: get this from recipe +my $useWarpPSF = 0; + +my $input = $ipprc->filename('PSWARP.OUTPUT', $path_base); +my $inputMask = $ipprc->filename('PSWARP.OUTPUT.MASK', $path_base); +my $inputVariance = $ipprc->filename('PSWARP.OUTPUT.VARIANCE', $path_base); +my $inputPSF = $useWarpPSF ? $ipprc->filename('PSPHOT.PSF.SKY.SAVE', $path_base) : ""; +my $inputSources = $ipprc->filename('PSPHOT.OUTPUT.CFF', $sourceroot); + +if ($verbose) { + print "input: $input\n"; + print "inputMask: $inputMask\n"; + print "inputVariance: $inputVariance\n"; + print "inputPSF: $inputPSF\n" if $inputPSF; + print "inputSources: $inputSources\n"; +} + +# check that the inputs exist (and have non-zero size) +&my_die("Couldn't find input: $input", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($input); +&my_die("Couldn't find input: $inputMask", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputMask); +&my_die("Couldn't find input: $inputVariance", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputVariance); +&my_die("Couldn't find input: $inputPSF", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR) if ($inputPSF && !$ipprc->file_exists($inputPSF)); +&my_die("Couldn't find input: $inputSources", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($inputSources); + +my $dump_config = 1; + +# Get the output filenames +my $outputSources = prepare_output("PSPHOT.OUT.CMF.MEF", $outroot, 1); +my $configuration = prepare_output("PSPHOT.SKY.CONFIG", $outroot, 1) if $dump_config; +my $outputStats = prepare_output("SKYCELL.STATS", $outroot, 1) if $doStats; +my $traceDest = prepare_output("TRACE.EXP", $outroot, 1); + +my $cmdflags = ""; +my $quality = 0; + +# Perform psphotFullForce +{ + my $command = "$psphotFullForce $outroot"; + $command .= " -force $inputSources"; + $command .= " -file $input"; + $command .= " -mask $inputMask"; + $command .= " -variance $inputVariance"; + $command .= " -psf $inputPSF" if $inputPSF; + $command .= " -threads $threads" if defined $threads; + if ($dump_config) { + $command .= " -dumpconfig $configuration"; + } + $command .= " -recipe PSPHOT $recipe_psphot"; + if ($doStats) { + $command .= " -stats $outputStats"; + } + $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + $command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF"; + $command .= " -photcode-rule '{DETECTOR}.{FILTER.ID}.ForcedWarp'"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psphotFullForce: $error_code", $ff_id, $warp_id, $skycell_id, $error_code); + } + + if ($doStats) { + check_output($outputStats, 1); + my $outputStatsReal = $ipprc->file_resolve($outputStats); + + # analyze the stats file + $command = "$ppStatsFromMetadata $outputStatsReal - WARP_SKYCELL"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $ff_id, $warp_id, $skycell_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + } + ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + + } else { + print "Not executing: $command\n"; + } +} + +if (!$quality) { + check_output($outputSources, 1); +} + +# Add the result to the database +{ + my $command = "$fftool -ff_id $ff_id -warp_id $warp_id"; + $command .= " -addresult -path_base $outroot"; + $command .= " $cmdflags"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform fftool -addwarped" ; + &my_die("$err_message: $error_code", $ff_id, $warp_id, $skycell_id, $error_code); + } + } else { + print "Not executing $command\n"; + } +} + +exit 0; + + +# Prepare to write to an output file +# Lookup the filename in the rules. +# Make sure that if file exists and is a nebulous file that there is only one instance +# Deal with files that have been lost. +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, undef, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $ff_id, $warp_id, $skycell_id, $error); + return $output; +} + +sub check_output +{ + my $file = shift; + my $replicate = shift; + + if (!defined $file) { + return; + } + + &my_die("Couldn't find expected output file: $file", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($file); + + # Funpack to confirm we've really made things correctly + my $diskfile = $ipprc->file_resolve($file); + if ($diskfile =~ /fits/) { + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR); + my $check_command = "$funpack -S $diskfile > /dev/null"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $check_command, verbose => $verbose); + if (!$success) { + &my_die("Output file not a valid fits file: $file", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR); + } + } + ##### + + if ($replicate and $neb) { + $ipprc->replicate_file($file) or &my_die("failed to replicate: $file\n", $ff_id, $warp_id, $skycell_id, $PS_EXIT_SYS_ERROR); + } +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $ff_id = shift; # full force run identifier + my $warp_id = shift; # full force warp id + my $skycell_id = shift; # Skycell identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $ff_id and defined $skycell_id) { + my $command = "$fftool -ff_id $ff_id -warp_id $warp_id -fault $exit_code"; + $command .= " -addresult"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -path_base $outroot" if defined $outroot; + $command .= " -dbname $dbname" if defined $dbname; + unless ($no_update) { + run(command => $command, verbose => $verbose); + } else { + print "not executing $command\n"; + } + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/publish_cleanup.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/publish_cleanup.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/publish_cleanup.pl (revision 41105) @@ -0,0 +1,173 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '1.0'; + +#use Date::Parse; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $dsrootls = can_run('dsrootls') or (warn "Can't find rootls" and $missing_tools = 1); +my $cleandsproduct = can_run('cleandsproduct.pl') or + (warn "Can't find cleandsproduct.pl" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($product, $datastore, $verbose); + +# Parse the command-line arguments +GetOptions( + 'product=s' => \$product, # product name + 'datastore=s' => \$datastore, # datastore uri + 'verbose' => \$verbose, # Print stuff? +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV\n", -exitval => 2 ) if @ARGV; + +if (!$datastore) { + $datastore = metadataLookupStr($ipprc->{_siteConfig}, "DATA_STORE_ROOT_URL"); + die ("Unable to find DATA_STORE_ROOT_URL in siteConfig\n") unless $datastore; +} + +my @product_list; +push @product_list, $product if $product; +if (!$product) { + my $uri = "$datastore/index.txt"; + + my $command = "$dsrootls --uri $uri --timeout 150 | grep IPP-MOPS"; + + # run the command. Don't set verbose here. That will just fill the log file uselessly. + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + die("Unable to perform $command: $error_code"); + } + + my @lines = split "\n", join("", @$stdout_buf); + + if ((scalar @lines) eq 1) { + print "no products found at $uri\n"; + exit 0; + } + + foreach my $line (@lines) { + chomp $line; + next if $line =~ /#/; + + my ($product_uri, $product_name, $update_time, $type, $desc) = split " ", $line; + + push @product_list, $product_name; + } + +} + +foreach my $product (@product_list) { + my $command = "$cleandsproduct --datastore $datastore --product $product"; + $command .= " --verbose" if $verbose; + + print "$command\n"; +} + +__END__ + +=pod +=head1 NAME + +cleandsproduct.pl - cleans up a data store product + +=head1 SYNOPSIS + +cleandsproduct.pl --product [--last-fileset ] [--no-rm] [--retention-days ] [--use-configured-publish-retention] + +=head1 DESCRIPTION + +Uses L to get a listing of all of the filesets in a data store product, then the program L is used to delete +the filesets from the data store directory and their representation in the database. + +By default, all filesets are deleted. Certain options may be used to stop the cleanup after a given fileset +or once all remaining filesets are newer than some time. + +=head1 OPTIONS + +=over 4 + +=item --product + +The name of the product to be cleaned up. + +Required. + +=item --retention-days + +The minimum number of days old for filesets to be cleaned. +Optional. + +=item --use-configured-publish-retention + +Get retention-days value from the SiteConfig +Optional. + +=item --last_fileset + +The FileSet ID of the last FileSet to be cleaned. Note: if the specified fileset is newer than the retention time +cleanup stops after cleaning that fileset. +Optional. + +=item --no-rm + +Update the database but do not remove the files on disk. The files will thus still exist, but they will be invisible +through the data store interface. + +=head1 Configuration Values + +The following configuration values are used to set certain default values. + +=item DATA_STORE_ROOT_URL + +The http address of the data store. Required. + +=item DATA_STORE_PUBLISH_RETENTION_DAYS + +The number of days that filesets in the publishing data stores should be preserved. Only used and required if +the option --use-configured-publish-retention is supplied. + +=back + +=head1 CREDITS + +Bill Sweeney IfA + +=head1 SUPPORT + +Please contact the author directly via e-mail. + +=head1 AUTHOR + +Bill Sweeney bills@ifa.hawaii.edu + +=head1 COPYRIGHT + +Copyright (C) 2011 - 2016 University of Hawaii IfA. + + +=head1 SEE ALSO + +L L + +=cut Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/publish_file.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/publish_file.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/publish_file.pl (revision 41105) @@ -0,0 +1,472 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Carp; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $pubtool = can_run('pubtool') or (warn "Can't find pubtool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $ppMops = can_run('ppMops') or (warn "Can't find ppMops" and $missing_tools = 1); +my $ppMonet = can_run('ppMonet') or (warn "Can't find ppMonet" and $missing_tools = 1); +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ( $pub_id, $camera, $stage, $stage_id, $fileset, $format, $product, $workdir, $need_magic ); +my ( $dbname, $verbose, $no_update, $no_op, $save_temps, $redirect ); +my ( $output_format, $difftype ); + +GetOptions( + 'pub_id=s' => \$pub_id, # Publish identifier + 'camera=s' => \$camera, # Camera name + 'stage=s' => \$stage, # Stage of interest + 'stage_id=s' => \$stage_id, # Stage identifier + 'product=s' => \$product, # Datastore product name + 'fileset=s' => \$fileset, # Fileset name + 'workdir=s' => \$workdir, # Working directory + 'need-magic' => \$need_magic, # do we require censored detections? + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations + 'save-temps' => \$save_temps, # Save temporary files? + 'redirect-output' => \$redirect, # Redirect output to log file? + 'output_format=i' => \$output_format, # Output format for ppMops + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --pub_id --camera --stage --stage_id --product --workdir", + -exitval => $PS_EXIT_CONFIG_ERROR) unless + defined $pub_id and + defined $camera and + defined $product and + defined $stage and + defined $stage_id and + defined $workdir and + defined $dbname; + +my $outroot = "$workdir/$product.$pub_id"; # Output root name + +my $ipprc = PS::IPP::Config->new( $camera ) or + &my_die( "Unable to set up", $pub_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +$ipprc->outroot_prepare( $outroot ); +my $logDest = "$outroot.log"; +$ipprc->redirect_output($logDest) or &my_die( "Unable to redirect output", $pub_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +my $mdcParser = PS::IPP::Metadata::Config->new; + +my $mops = ($product =~ /^IPP-MOPS/ ? 1 : 0); # Format for MOPS? +my ($dsFile, $dsFileName) = tempfile("/tmp/publish.$pub_id.ds.XXXX", UNLINK => !$save_temps ); +my $dsType = $mops ? "IPP-MOPS" : $product; # Type for DataStore + +my $comment; # Comment for exposure +my $exp_name_1; # Name of exposure 1 +my $exp_name_2; # Name of exposure 2 +if ($stage eq 'camera') { + my $command = "camtool -processedexp -cam_id $stage_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to retrieve filename", $pub_id, $PS_EXIT_SYS_ERROR) unless $success; + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $pub_id, $PS_EXIT_PROG_ERROR); + + my $components = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $pub_id, $PS_EXIT_PROG_ERROR); + + &my_die("More than one entry for cam_id $stage_id", $pub_id, $PS_EXIT_PROG_ERROR) if scalar @$components > 1; + + my $comp = $$components[0]; # Component of interest + my $path_base = $comp->{path_base}; # Base name for file + my $file = $ipprc->filename( "PSASTRO.OUTPUT", $path_base ); + $file = $ipprc->file_resolve($file); + my $exp_name = $comp->{exp_name}; + my $exp_id = $comp->{exp_id}; + my $chip_id = $comp->{chip_id}; + my $cam_id = $comp->{cam_id}; + my $zp = $comp->{zpt_obs}; + my $zp_err = $comp->{zpt_stdev}; + my $astrom = sqrt($comp->{sigma_ra}**2 + $comp->{sigma_dec}**2); + my $name = "cam_$cam_id"; + $comment = $comp->{comment}; + + if ($product eq "MONET") { + my $output = $ipprc->file_resolve( "$outroot.csv.gz", 'create' ) or + &my_die( "Unable to resolve output file", $pub_id, $PS_EXIT_SYS_ERROR); + + my $command = "$ppMonet $file $output"; + $command .= " -exp_name " . $exp_name if defined $exp_name; + $command .= " -exp_id " . $exp_id if defined $exp_id; + $command .= " -chip_id " . $chip_id if defined $chip_id; + $command .= " -cam_id " . $cam_id if defined $cam_id; + $command .= " -zp " . $zp if defined $zp; + $command .= " -zp_error " . $zp_err if defined $zp_err; + $command .= " -astrom_rms " . $astrom if defined $astrom; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to translate", $pub_id, $PS_EXIT_SYS_ERROR) unless $success; + &my_die( "Unable to find translated file $output", $pub_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists( $output ); + } else { + print "Not running: $command\n"; + } + + $file = $output; + } + print $dsFile "$file|||$product|$name|\n"; + +} elsif ($stage eq 'diff' or $stage eq 'diffphot') { + my $command; # Command to run + if ($stage eq 'diff') { + $command = "difftool -diffskyfile -diff_id $stage_id"; + } elsif ($stage eq 'diffphot') { + $command = "diffphottool -data -diff_phot_id $stage_id"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to retrieve filename", $pub_id, $PS_EXIT_SYS_ERROR) unless $success; + + my $components = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config", $pub_id, $PS_EXIT_PROG_ERROR); + + my ($mopsPositiveFile, $mopsPositiveFileName) = tempfile("/tmp/publish.$pub_id.mops.pos.XXXX", UNLINK => !$save_temps ) if $mops; + my ($mopsNegativeFile, $mopsNegativeFileName) = tempfile("/tmp/publish.$pub_id.mops.neg.XXXX", UNLINK => !$save_temps ) if $mops; + + my %positive; # Data for positive diff detections + my %negative; # Data for negative diff detections + foreach my $comp ( @$components ) { + my $path_base = $comp->{path_base}; # Base name for file + if (!$need_magic and $comp->{magicked}) { + # This client is authorized to receive uncensored detections + # Get the uri for the "backup" files + print "Using uncensored input from $path_base\n"; + $path_base = $ipprc->destreaked_filename($path_base); + } + next if defined $comp->{quality} and $comp->{quality} > 0; + print "Warning: mis-matched comments\n" if defined $comment and $comment ne $comp->{comment}; + $comment = $comp->{comment} unless defined $comment; + $exp_name_1 = $comp->{exp_name_1} unless defined $exp_name_1; + $exp_name_2 = $comp->{exp_name_2} unless defined $exp_name_2; + + (carp "Bad zpt_obs or exp_time for component" and next) if not defined $comp->{zpt_obs} or not defined $comp->{exp_time}; + my $zp = $comp->{zpt_obs} + 2.5 * log($comp->{exp_time}) / log(10); + my $astrom = sqrt($comp->{sigma_ra_1}**2 + $comp->{sigma_dec_1}**2); + + my $skycell_id = $comp->{skycell_id}; + my $filename; + if ($stage eq 'diff') { + $filename = $ipprc->filename( "PPSUB.OUTPUT.SOURCES", $path_base ); + } elsif ($stage eq 'diffphot') { + $filename = $ipprc->filename( "PSPHOT.OUT.CMF.MEF", "$path_base.pos" ); + } + &my_die("input file does not exist: $filename", $pub_id, $PS_EXIT_SYS_ERROR) if !$ipprc->file_exists($filename); + my $resolved = $ipprc->file_resolve($filename); + + &my_die("unable to resolve input file: $filename", $pub_id, $PS_EXIT_SYS_ERROR) if !$resolved; + + $filename = $resolved; + + my $cam_id = $comp->{cam_id_1}; + #print "Getting info from camera stage $cam_id\n"; + my $cam_command = "$camtool -processedexp -cam_id $cam_id"; + $cam_command .= " -dbname $dbname" if defined $dbname; + my ( $cam_success, $cam_error_code, $cam_full_buf, $cam_stdout_buf, $cam_stderr_buf ) = + run(command => $cam_command, verbose => $verbose); + &my_die( "Unable to retrieve filename", $pub_id, $PS_EXIT_SYS_ERROR) unless $cam_success; + my $cam_metadata = $mdcParser->parse(join "", @$cam_stdout_buf) or + &my_die("Unable to parse metadata config", $pub_id, $PS_EXIT_PROG_ERROR); + my $cam_components = parse_md_list($cam_metadata) or + &my_die("Unable to parse metadata list", $pub_id, $PS_EXIT_PROG_ERROR); + &my_die("More than one entry for cam_id $stage_id", $pub_id, $PS_EXIT_PROG_ERROR) if scalar @$cam_components > 1; + my $cam_comp = $$cam_components[0]; + + my $exp_id = $comp->{exp_id_1}; + #print "Getting info from raw stage $exp_id\n"; + my $reg_command = "$regtool -processedimfile -exp_id $exp_id"; + $reg_command .= " -dbname $dbname" if defined $dbname; + my ( $reg_success, $reg_error_code, $reg_full_buf, $reg_stdout_buf, $reg_stderr_buf ) = + run(command => $reg_command, verbose => $verbose); + &my_die( "Unable to retrieve filename", $pub_id, $PS_EXIT_SYS_ERROR) unless $reg_success; + my $reg_metadata = $mdcParser->parse(join "", @$reg_stdout_buf) or + &my_die("Unable to parse metadata config", $pub_id, $PS_EXIT_PROG_ERROR); + my $reg_components = parse_md_list($reg_metadata) or + &my_die("Unable to parse metadata list", $pub_id, $PS_EXIT_PROG_ERROR); + my $reg_comp = $$reg_components[0]; + + # Now get the difftype value from diff->{diff_mode} + my $difftype = ""; + if ($comp->{diff_mode} == 1) { + $difftype = "WW"; + } elsif ($comp->{diff_mode} == 2) { + $difftype = "WS"; + } elsif ($comp->{diff_mode} == 3) { + $difftype = "SW"; # Not used yet + } elsif ($comp->{diff_mode} == 4) { + $difftype = "SS"; + } else { + $difftype = "Unsupported diff_mode value: [" . $comp->{diff_mode} . "]"; + } + + my $data = { zp => $zp, + zp_err => $comp->{zpt_stdev}, + astrom => sqrt($comp->{sigma_ra_1}**2 + $comp->{sigma_dec_1}**2), + exp_name => $comp->{exp_name_1}, + exp_id => $comp->{exp_id_1}, + chip_id => $comp->{chip_id_1}, + cam_id => $comp->{cam_id_1}, + fake_id => $comp->{fake_id_1}, + warp_id => $comp->{warp1}, + diff_id => $comp->{diff_id}, + camera => $comp->{camera}, + output_format => $comp->{output_format}, + direction => 1, + comment => $reg_comp->{comment}, + obsmode => $reg_comp->{obs_mode}, + difftype => $difftype, + sky => $cam_comp->{bg}, + shutoutc => $reg_comp->{dateobs}, + }; + + #warn("Checking for positive"); + diff_check(\%positive, $data, "positive"); + + if ($mops) { + print $mopsPositiveFile "$filename\n"; + } else { + print $dsFile "$filename|||$product|${skycell_id}.pos|\n"; + } + + # Negative direction + if (defined $comp->{bothways} and $comp->{bothways}) { + my $filename; + if ($stage eq 'diff') { + $filename = $ipprc->filename( "PPSUB.INVERSE.SOURCES", $path_base ); + } elsif ($stage eq 'diffphot') { + $filename = $ipprc->filename( "PSPHOT.OUT.CMF.MEF", "$path_base.neg" ); + } + + $filename = $ipprc->file_resolve($filename); + + my $data = { zp => $zp, + zp_err => $comp->{zpt_stdev}, + astrom => sqrt($comp->{sigma_ra_2}**2 + $comp->{sigma_dec_2}**2), + exp_name => $comp->{exp_name_2}, + exp_id => $comp->{exp_id_2}, + chip_id => $comp->{chip_id_2}, + cam_id => $comp->{cam_id_2}, + fake_id => $comp->{fake_id_2}, + warp_id => $comp->{warp2}, + diff_id => $comp->{diff_id}, + camera => $comp->{camera}, + # missing output_format? + direction => 0, + comment => $reg_comp->{comment}, + obsmode => $reg_comp->{obs_mode}, + difftype => $difftype, + sky => $cam_comp->{bg}, + shutoutc => $reg_comp->{dateobs}, + }; + + #warn("Checking for negative"); + diff_check(\%negative, $data, "negative"); + + if ($mops) { + print $mopsNegativeFile "$filename\n"; + } else { + print $dsFile "$filename|||$dsType|${skycell_id}.neg|\n"; + } + } + } + + close $mopsPositiveFile if $mops; + close $mopsNegativeFile if $mops; + + if ($mops) { + if (scalar keys %positive > 0) { + my $output = mops_combine(\%positive, "$outroot.pos.mops", $mopsPositiveFileName); + print $dsFile "$output|||$dsType|positive|\n"; + } + if (scalar keys %negative > 0) { + my $output = mops_combine(\%negative, "$outroot.neg.mops", $mopsNegativeFileName); + print $dsFile "$output|||$dsType|negative|\n"; + } + } +} + +close $dsFile; + +unless ($no_update) { + my $command = "$dsreg --add pub.$pub_id.$stage.$stage_id --link --abspath --product $product --type $dsType --list $dsFileName"; + $command .= " --ps0 \"$comment\"" if defined $comment; + $command .= " --ps1 \"$exp_name_1\"" if defined $exp_name_1; + $command .= " --ps2 \"$exp_name_2\"" if defined $exp_name_2; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to register with data store", $pub_id, $PS_EXIT_SYS_ERROR) unless $success; +} + +unless ($no_update) { + my $command = "$pubtool -add -pub_id $pub_id -path_base $outroot"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to register with data store", $pub_id, $PS_EXIT_SYS_ERROR) unless $success; +} + +### Pau. + +# Check inputs for a diff +sub diff_check +{ + my $data = shift; # Data hash + my $comp = shift; # Component data + my $name = shift; # Name of component + + $data->{zp} = $comp->{zp} unless defined $data->{zp}; + $data->{zp_err} = $comp->{zp_err} unless defined $data->{zp_err}; + $data->{astrom} = $comp->{astrom} unless defined $data->{astrom}; + $data->{exp_name} = $comp->{exp_name} unless defined $data->{exp_name}; + $data->{exp_id} = $comp->{exp_id} unless defined $data->{exp_id}; + $data->{chip_id} = $comp->{chip_id} unless defined $data->{chip_id}; + $data->{cam_id} = $comp->{cam_id} unless defined $data->{cam_id}; + $data->{fake_id} = $comp->{fake_id} unless defined $data->{fake_id}; + $data->{warp_id} = $comp->{warp_id} unless defined $data->{warp_id}; + $data->{diff_id} = $comp->{diff_id} unless defined $data->{diff_id}; + $data->{camera} = $comp->{camera} unless defined $data->{camera}; + # missing output_format? + $data->{direction} = $comp->{direction} unless defined $data->{direction}; + $data->{comment} = $comp->{comment} unless defined $data->{comment}; + $data->{obsmode} = $comp->{obsmode} unless defined $data->{obsmode}; + $data->{difftype} = $comp->{difftype} unless defined $data->{difftype}; + $data->{sky} = $comp->{sky} unless defined $data->{sky}; + $data->{shutoutc} = $comp->{shutoutc} unless defined $data->{shutoutc}; + + &my_die("zp value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{zp} and $comp->{zp} != $data->{zp}; + &my_die("zp_err value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{zp_err} and $comp->{zp_err} != $data->{zp_err}; + &my_die("astrom value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{astrom} and $comp->{astrom} != $data->{astrom}; + &my_die("exp_name value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{exp_name} and $comp->{exp_name} ne $data->{exp_name}; + &my_die("exp_id value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{exp_id} and $comp->{exp_id} != $data->{exp_id}; + &my_die("chip_id value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{chip_id} and $comp->{chip_id} != $data->{chip_id}; + &my_die("cam_id value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{cam_id} and $comp->{cam_id} != $data->{cam_id}; + &my_die("fake_id value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{fake_id} and $comp->{fake_id} != $data->{fake_id}; + &my_die("warp_id value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{warp_id} and $comp->{warp_id} != $data->{warp_id}; + &my_die("diff_id value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{diff_id} and $comp->{diff_id} != $data->{diff_id}; + &my_die("camera value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{camera} and $comp->{camera} ne $data->{camera}; + &my_die("direction value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{direction} and $comp->{direction} != $data->{direction}; + &my_die("comment value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{comment} and $comp->{comment} ne $data->{comment}; + &my_die("obsmode value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{obsmode} and $comp->{obsmode} ne $data->{obsmode}; + &my_die("difftype value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{difftype} and $comp->{difftype} ne $data->{difftype}; + &my_die("sky value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{sky} and $comp->{sky} != $data->{sky}; + &my_die("shutoutc value for $name doesn't match", $pub_id, $PS_EXIT_SYS_ERROR) if defined $data->{shutoutc} and $comp->{shutoutc} ne $data->{shutoutc}; + + return 1; +} + +# Combine multiple files for MOPS +sub mops_combine +{ + my $data = shift; # Data + my $output = shift; # Output name + my $input = shift; # Input name + + $output = $ipprc->file_resolve( $output, 'create' ) or + &my_die( "Unable to resolve output file $output", $pub_id, $PS_EXIT_SYS_ERROR); + + my $command = "$ppMops $input $output"; + $command .= " -exp_name " . $data->{exp_name} if defined $data->{exp_name}; + $command .= " -exp_id " . $data->{exp_id} if defined $data->{exp_id}; + $command .= " -chip_id " . $data->{chip_id} if defined $data->{chip_id}; + $command .= " -cam_id " . $data->{cam_id} if defined $data->{cam_id}; + $command .= " -fake_id " . $data->{fake_id} if defined $data->{fake_id}; + $command .= " -warp_id " . $data->{warp_id} if defined $data->{warp_id}; + $command .= " -diff_id " . $data->{diff_id} if defined $data->{diff_id}; + $command .= " -camera " . $data->{camera} if defined $data->{camera}; + $command .= " -inverse" if defined $data->{direction} and $data->{direction} == 0; + $command .= " -zp " . $data->{zp} if defined $data->{zp}; + $command .= " -zp_error " . $data->{zp_err} if defined $data->{zp_err}; + $command .= " -astrom_rms " . $data->{astrom} if defined $data->{astrom}; + $command .= " -version " . $data->{output_format} if defined $data->{output_format}; + $command .= " -comment \"" . $data->{comment} . "\"" if defined $data->{comment}; + $command .= " -obsmode \"" . $data->{obsmode} . "\"" if defined $data->{obsmode}; + $command .= " -difftype " . $data->{difftype} if defined $data->{difftype}; + $command .= " -sky " . $data->{sky} if defined $data->{sky}; + $command .= " -shutoutc \"" . $data->{shutoutc} . "\"" if defined $data->{shutoutc}; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to translate", $pub_id, $PS_EXIT_SYS_ERROR) unless $success; + &my_die( "Unable to find translated file $output", $pub_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists( $output ); + } else { + print "Not running: $command\n"; + } + + return $output; +} + + +sub my_die +{ + my $msg = shift; # Exit message + my $pub_id = shift; # Publish run identifier + my $fault = shift; # Fault code + + $fault = $PS_EXIT_PROG_ERROR unless defined $fault; + + carp($msg); + if (defined $pub_id and not $no_update) { + my $command = "$pubtool -add"; + $command .= " -pub_id $pub_id"; + $command .= " -path_base $outroot"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -fault $fault"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + } + exit $fault; +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/queue_chips_by_night.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/queue_chips_by_night.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/queue_chips_by_night.pl (revision 41105) @@ -0,0 +1,102 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $stdate = `date`; +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my @ARGS = @ARGV; + +my ( $date, $data_group_base, $label, $tess_id, $end_stage, $workdir_base, $dbname ); + +GetOptions( + 'date=s' => \$date, # date, like this 2011-02-12 + 'data_group_base=s' => \$data_group_base, # data_group_base, like this: isp + 'label=s' => \$label, # label + 'dbname|d=s' => \$dbname, # Database name + 'tess_id=s' => \$tess_id, # tess_id + 'end_stage=s' => \$end_stage, # end_stage + 'workdir_base=s' => \$workdir_base, # workdir + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dbname --label --tess_id --date \n Optional: --data_group_base, end_stage, workdir_base", + -exitval => 3) unless + defined $dbname and + defined $label and + defined $tess_id and + defined $date; + +my $truncdate = $date; + $truncdate =~ s/-//g; +if (defined $data_group_base) { + print "found data_group_base = $data_group_base\n"; +} else { + $data_group_base = $label; + print "using $label as data_group_base\n"; +} +if (defined $end_stage) { + print "found end_stage = $end_stage\n"; +} else { + $end_stage = "camera"; + print "using camera as end_stage\n"; +} +if (defined $workdir_base) { + print "found workdir_base = $workdir_base\n"; +} else { + $workdir_base = "neb://\@HOST\@.0/$dbname/$label"; + print "using $workdir_base as workdir\n"; +} + +# we have all the pieces, now build up the chiptool: + +my $command = "$chiptool -definebyquery -unique"; +$command .= " -dbname $dbname"; +$command .= " -dateobs_begin '$date"."T00:00:00'"; +$command .= " -dateobs_end '$date"."T23:59:59'"; +$command .= " -set_label $label"; +$command .= " -set_data_group $data_group_base.$truncdate"; +$command .= " -set_workdir $workdir_base/$truncdate"; +$command .= " -set_end_stage $end_stage"; +$command .= " -set_tess_id $tess_id"; + +print "\nrunning this command:\n\n$command\n\n"; + + +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform chiptool -definebyquery: $error_code\n"); + exit($error_code); + +} + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/queuestaticsky.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/queuestaticsky.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/queuestaticsky.pl (revision 41105) @@ -0,0 +1,279 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Carp; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use POSIX qw(strftime); +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +my ($seq_id, $tess_id, $projection_cell, $label, $dist_group, $dbname, $pretend, $simple, $verbose, $no_update); + +my $good_frac_min = 0.05; + +GetOptions( + 'seq_id=s' => \$seq_id, + 'tess_id=s' => \$tess_id, + 'projection_cell=s' => \$projection_cell, + 'label=s' => \$label, + 'dist_group=s' => \$dist_group, + 'dbname=s' => \$dbname, + 'pretend' => \$pretend, + 'simple' => \$simple, + 'no-update' => \$no_update, + 'verbose|v' => \$verbose, +) or pod2usage(2); + +unless (defined $seq_id and defined $tess_id and defined $projection_cell and defined $label and defined $dist_group) { + warn ("label, seq_id, tess_id, and projection_cell are required\n"); + pod2usage(2); +}; + +# don't update the database if we are pretending +$no_update = 1 if $pretend; + +my $missing_tools; +my $laptool = can_run('laptool') or (warn "Can't find laptool" and $missing_tools = 1); +my $staticskytool = can_run('staticskytool') or (warn "Can't find staticskytool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $PS_EXIT_CONFIG_ERROR ); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# XXX get from site.config +my $workdirBase = "neb://\@HOST\@.0/gpc1"; + +my @filters; +{ + my $command = "$laptool -filtersforgroup"; + $command .= " -seq_id $seq_id"; + $command .= " -tess_id $tess_id"; + $command .= " -projection_cell $projection_cell"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => 0); + unless ($success) { + $error_code = $error_code >> 8; + my_die("failed to run $command $error_code\n", $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $PS_EXIT_PROG_ERROR); + my $list = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $PS_EXIT_PROG_ERROR); + + foreach my $entry (@$list) { + push @filters, $entry->{filter}; + } +} + +my $nFilters = scalar @filters; +print STDERR "lapGroup $seq_id $tess_id $projection_cell has $nFilters filters\n"; + +&my_die("No filters found for $seq_id $tess_id $projection_cell", $PS_EXIT_PROG_ERROR) unless $nFilters; +&my_die("Unexpected number of filters found for $seq_id $tess_id $projection_cell", $PS_EXIT_PROG_ERROR) unless $nFilters <= 5; + +my $datestr = strftime "%Y/%m/%d", gmtime; + +my $staticsky_command="staticskytool -definebyquery" + . " -select_label $label" + . " -select_tess_id $tess_id" + . " -select_skycell_id $projection_cell%" + . " -set_workdir $workdirBase/$label/$datestr" + . " -select_good_frac_min $good_frac_min" + . " -set_label $label" + . " -set_data_group $label" + . " -set_dist_group $dist_group"; + +$staticsky_command .= " -pretend" if $pretend; +$staticsky_command .= " -simple" if $simple; +$staticsky_command .= " -dbname $dbname" if $dbname; + +for (my $num = $nFilters; $num > 0; $num--) { + + # set up the possible combinations of $num filters from @filters + + my $filter_combos = setup_filter_combos($num); + + # printcombos($filter_combos) if $verbose; + + foreach my $filter_combo (@$filter_combos) { + my $command = $staticsky_command; + foreach my $f (@$filter_combo) { + $command .= " -select_filter $f"; + } + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = $error_code >> 8; + my_die("failed to run $command $error_code\n", $error_code); + } + } + last if $pretend; # only do the first (full) set if we are in pretend mode +} +{ + my $command = "$laptool -updategroup"; + $command .= " -seq_id $seq_id"; + $command .= " -tess_id $tess_id"; + $command .= " -projection_cell $projection_cell"; + $command .= " -set_state full"; + $command .= " -dbname $dbname" if defined $dbname; + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = $error_code >> 8; + carp("failed to run $command $error_code\n", $error_code); + exit $error_code; + } + } else { + print STDERR "Skipping $command\n"; + } +} + +exit 0; + +sub my_die +{ + my $msg = shift; + my $exit_code = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless $exit_code; + + carp($msg); + + my $command = "$laptool -updategroup"; + $command .= " -seq_id $seq_id"; + $command .= " -tess_id $tess_id"; + $command .= " -projection_cell $projection_cell"; + $command .= " -set_fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = $error_code >> 8; + carp("failed to run $command $error_code\n", $error_code); + exit $error_code; + } + } else { + print STDERR "Skipping $command\n"; + } + exit $exit_code; +} + + +# The rest of this file contains some subroutines for setting up the filter combinations + + +sub setup_filter_combos { + my $combos = shift; + + my_die( "invalid combos arg: $combos", $PS_EXIT_PROG_ERROR) + unless defined $combos and ($combos eq "5" or $combos eq "4" or $combos eq "3" or $combos eq "2" or $combos eq "1"); + + if ($combos eq 5) { + my @ary; + push @ary, \@filters; + return \@ary; + } elsif ($combos eq 4) { + return makecombo4(); + } elsif ($combos eq 3) { + return makecombo3(); + } elsif ($combos eq 2) { + return makecombo2(); + } elsif ($combos eq 1) { + my @ary; + foreach my $f (@filters) { + my @ary2 = ($f); + push @ary, \@ary2 + } + return \@ary; + } else { + die "how did we get here?"; + } +} + + + +sub printcombos { + my $combos = shift; + foreach my $c (@$combos) { + my $str; + foreach my $f (@$c) { + $str .= " -select_filter $f"; + } + print "$str\n"; + } +} + + +sub makecombo4 { + my $numFilters = scalar @filters; + my @combos; + + for (my $i = 0; $i < $numFilters; $i++) { + for (my $j = $i + 1; $j < $numFilters; $j++) { + for (my $k = $j + 1; $k < $numFilters; $k++) { + for (my $l = $k + 1; $l < $numFilters; $l++) { + my @combo = ($filters[$i], $filters[$j], $filters[$k], $filters[$l]); + push @combos, \@combo; + } + } + } + } + return \@combos; +} + +sub makecombo3 { + my $numFilters = scalar @filters; + my @combos; + + for (my $i = 0; $i < $numFilters; $i++) { + for (my $j = $i + 1; $j < $numFilters; $j++) { + for (my $k = $j + 1; $k < $numFilters; $k++) { + my @combo = ($filters[$i], $filters[$j], $filters[$k]); + push @combos, \@combo; + } + } + } + return \@combos; +} + +sub makecombo2 { + my $numFilters = scalar @filters; + my @combos; + + for (my $i = 0; $i < $numFilters; $i++) { + for (my $j = $i + 1; $j < $numFilters; $j++) { + my @combo = ($filters[$i], $filters[$j]); + push @combos, \@combo; + } + } + return \@combos; +} + + +__END__ + +=pod + +=head1 NAME + +queuesskylap - queue LAP staticsky runs + +=head1 SYNOPSIS + + XXX: pod TODO + + queuesskylap --ra_min --ra_max --dec_min --dec_max [--go] + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rawcheck.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rawcheck.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rawcheck.pl (revision 41105) @@ -0,0 +1,549 @@ +#!/usr/bin/env perl + +use strict; +use warnings FATAL => qw( all ); + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Nebulous::Client; + +use Getopt::Long qw( GetOptions :config auto_help auto_version ); +use Pod::Usage qw( pod2usage ); +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Digest::MD5; +use URI; + +my $missing_tools = 0; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); + + +my ($server,$dbname,$exp_id,$do_cull,$save_log); + +$server = $ENV{'NEB_SERVER'} unless $server; +# $dbname = 'gpc1'; +GetOptions( + 'server|s=s' => \$server, + 'dbname=s' => \$dbname, + 'exp_id|x=s' => \$exp_id, + 'save_log' => \$save_log, + 'cull' => \$do_cull, +) || pod2usage( 2 ); + +unless(defined($do_cull)) { + $do_cull = 0; +} + +# Option parsing +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --server", -exitval => 2 ) + unless $server; +pod2usage( -msg => "Required options: --dbname", -exitval => 2 ) + unless $dbname; +pod2usage( -msg => "missing key", exitval => 2 ) + unless defined $exp_id; + +if ($save_log) { + my $time = time(); + my $logDest = "neb://any/raw_check/exp_${exp_id}"; + my $ipprc = PS::IPP::Config->new( "GPC1" ) or die "Could not create config object.\n"; + $ipprc->redirect_to_logfile($logDest) or die "Could not redirect output to logfile ${logDest}\n"; +} + +# Global options: +## Define the configuration. Ideally, this would be retrieved from the nebulous +## database, but there are some issues with that (such as grouping the b nodes +## into a less restrictive "offsite" location). + +my $do_ops = 1; +my $i; + +## Set up nebulous db interface, and pull processing information to consider. +my $neb = Nebulous::Client->new( + proxy => "$server", +); +die "can't connected to Nebulous Server: $server" + unless defined $neb; + +## This new implementation is somewhat messy, but is more general and adaptable. +## First, we set up a requirement mapping, explaining where we want copies, and +## how many copies we want at each site. +my %requirement_map = (); +# CZW: 2017-01-10: I've changed this to MRTCB=1, OFFSITE=0, from MRTCB=0, OFFSITE=1 to attempt to speed +# up the shuffle (which is OFFSITE limited). Setting MRTCB=1 to ensure two copies in +# in the system (not totally necessary for everything, but a precaution in case this +# is run in cull mode without an edit back). +$requirement_map{ITC} = 1; +$requirement_map{OFFSITE} = 0; +$requirement_map{MRTCB} = 1; + +## Second, construct a list of volumes, mapped to their site location, using the +## same site locations as in the requirement map. +my %volume_map = (); +for ($i = 4; $i <= 21; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 23; $i <= 32; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 54; $i <= 97; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 100; $i <= 104; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; + $vol = sprintf("ipp%03d.1",$i); + $volume_map{$vol} = 'MRTCB'; +} +for ($i = 105; $i <= 117; $i++) { +# if ($i == 115) { next; } + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'ITC'; + $vol = sprintf("ipp%03d.1",$i); + $volume_map{$vol} = 'ITC'; +} +for ($i = 118; $i <= 122; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'MRTCB'; + $vol = sprintf("ipp%03d.1",$i); + $volume_map{$vol} = 'MRTCB'; +} + + +for ($i = 0; $i <= 15; $i++) { + my $loc = 'OFFSITE'; + if ($i == 6) { + $loc = 'MRTCB'; + } # This isn't "offsite", it's with the rest of the maui cluster. + if ($i == 9) { next; } # Not online + + my $vol = sprintf("ippb%02d.0",$i); + $volume_map{$vol} = $loc; + $vol = sprintf("ippb%02d.1",$i); + $volume_map{$vol} = $loc; + if ($i <= 6) { + $vol = sprintf("ippb%02d.2",$i); + $volume_map{$vol} = $loc; + } +} + +## Next, get disk space values, and check which hosts are listed as available. +my %acceptable_volume = (); +my $mounts = $neb->mounts(); +foreach my $vol_row (@$mounts) { + my ($mount_point, $total, $used, $vol_id, $name, $host, $path, $allocate, $available, $xattr) = @{ $vol_row }; + if (($allocate == 1)&&($available == 1)&&( $used / $total < 0.98)) { + $acceptable_volume{$name} = 1; + } + else { + print "## $name $allocate $available $used $total\n"; + $acceptable_volume{$name} = 0; + } + if ($name =~ /ippb05/) { + $acceptable_volume{$name} = 0; + } +# if (($name eq 'ipp106.0')||($name eq 'ipp106.1')) { +# $acceptable_volume{$name} = 0; +# } +} + +## Finally, generate lists containing which volumes are located at which site. +## This allows us to randomly select a volume from the list for the site that +## we plan on replicating to. +my %volume_lists = (); +foreach my $vol_key (keys %requirement_map) { + @{ $volume_lists{$vol_key} } = grep { $acceptable_volume{$_} == 1 } ( + grep { $volume_map{$_} eq $vol_key } (keys %volume_map) + ); + print "$vol_key " . join(' ', @{ $volume_lists{$vol_key} }) . "\n"; + + if ($#{ $volume_lists{$vol_key} } == -1) { + die "No acceptable volume found for site $vol_key!\n"; + } +} + +# die; +# Pull data from the gpc1 database about the exposure to consider + +my $verbose = 0; +my $mdcParser = PS::IPP::Metadata::Config->new; + +print("$regtool -processedimfile -exp_id $exp_id -dbname $dbname\n"); +my $regtool_cmd = "$regtool -processedimfile -exp_id $exp_id -dbname $dbname"; +my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $regtool_cmd, verbose => 0); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform regtool -processedimfile: $error_code", $exp_id); +} +my $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from regtool -processedimfile", $exp_id); + +my $timer_start = time(); +my $timer = time(); +print "## rawcheck.pl: $exp_id $dbname $do_cull $do_ops $timer_start\n"; +# Do prescan checks. +if ($#{ $imfiles } > 0) { + my @to_do_imfiles = (); + my $prior_imfile; + my $append = 0; + + foreach my $imfile (@$imfiles) { + my $key = $imfile->{uri}; + my $data_state = $imfile->{data_state}; + my $md5sum = $imfile->{md5sum}; + my $hostname = $imfile->{hostname}; + my $class_id = $imfile->{class_id}; + + my $stat = $neb->stat($key); + die "nebulous key: $key not found" unless $stat; + my $instances = $neb->find_instances($key, 'any'); + die "no instances found" unless $instances; + my @files = map {URI->new($_)->file if $_} @$instances; + + print ("\n#PRE: $key $data_state $md5sum $hostname $class_id T: $timer\n"); + + my $has_itc_copy = 0; + my @validation = (); + for (my $i = 0; $i <= $#files; $i++) { + # Check for itc copy. + my ($instance_exists,$instance_md5sum,$instance_host,$instance_volume,$instance_site, $is_good); + ($instance_host,$instance_volume) = parse_volume($files[$i]); + $instance_site = $volume_map{$instance_volume}; + + if ($instance_site eq 'ITC') { + $has_itc_copy = 1; + } + + + $validation[$i] = sprintf(" % 3d %d %32s %s %s %s %s\n", + -1,-1,"UNCHECKED", + $files[$i],$instance_host,$instance_volume,$instance_site); + + } + my $val_string = join('',@validation); + print "$val_string"; + + if ($append == 0) { + if ($has_itc_copy == 0) { + if (defined($prior_imfile)) { + push @to_do_imfiles, $prior_imfile; + } + $append = 1; + } + } + + if ($append == 1) { + push @to_do_imfiles, $imfile; + } + printf( "#PRE_RESULT: %2d %2d %2d %2d\n",$has_itc_copy,$append,$#to_do_imfiles,$#{ $imfiles }); + $prior_imfile = $imfile; + } + + @$imfiles = @to_do_imfiles; +} +# End prescan checks. + +# Loop over the imfiles of this exposure. +foreach my $imfile (@$imfiles) { + my $key = $imfile->{uri}; + my $data_state = $imfile->{data_state}; + my $md5sum = $imfile->{md5sum}; + my $hostname = $imfile->{hostname}; + my $class_id = $imfile->{class_id}; + + if (!(defined($hostname))) { $hostname = 'ipp004'; } + $timer = time() - $timer_start; + print ("\n# $key $data_state $md5sum $hostname $class_id T: $timer\n"); + + ## Get instances, and do validation that they have the correct md5sums. + my $stat = $neb->stat($key); + die "nebulous key: $key not found" unless $stat; + my $instances = $neb->find_instances($key, 'any'); + die "no instances found" unless $instances; + + my $existing_copies = 0; + my $Ngood = 0; + my $Nbad = 0; + my %good_instances = (); + my %bad_instances = (); + + #unsafe + my $continue_checking_md5sums = 1; + my %good_instances_unchecked = (); + #end unsafe + + my @files = map {URI->new($_)->file if $_} @$instances; + my @validation = (); + + for (my $i = 0; $i <= $#files; $i++) { + my ($instance_exists,$instance_md5sum,$instance_host,$instance_volume,$instance_site, $is_good); + ($instance_host,$instance_volume) = parse_volume($files[$i]); + $instance_site = $volume_map{$instance_volume}; + $is_good = 0; + + if (-e $files[$i]) { + $instance_exists = 1; + $existing_copies++; + if ($instance_site eq 'ITC') { # This is here to force checking of ITC copy. + $continue_checking_md5sums = 1; + } + if ($continue_checking_md5sums == 1) { #unsafe + $instance_md5sum = local_md5sum($files[$i]); + if ($instance_md5sum eq $md5sum) { + push @{ $good_instances{$instance_site} }, $i; + $is_good = 1; + $Ngood++; + } + else { + push @{ $bad_instances{$instance_site} }, $i; + $Nbad++; + } + } #unsafe + else { #unsafe + $instance_md5sum = 'CHECKING_STOPPED'; + push @{ $good_instances_unchecked{$instance_site} }, $i; + $is_good = 1; + $Ngood++; + } #end unsafe + } + else { + $instance_exists = 0; + $instance_md5sum = 'NON-EXISTANT'; + push @{ $bad_instances{$instance_site} }, $i; + } + + $validation[$i] = sprintf(" % 3d %d %32s %s %s %s\n", + $instance_exists,$is_good,$instance_md5sum, + $files[$i],$instance_host,$instance_volume); + + #unsafe + # Remove this section when we decide to go back to actually checking everything + # to make sure we don't have any secret data corruption + if ($Ngood > 0) { + print "# Breaking from validation check, as a valid copy has been found.\n"; + $continue_checking_md5sums = 0; + } + #end unsafe + } + + $timer = time() - $timer_start; + # object_id ext_id epoch available existing total timer + printf("%s %s %s %d %d %d %d\n",@$stat[0],@$stat[1],@$stat[4],@$stat[6],$existing_copies,@$stat[7],$timer); + # instance_exists is_good instance_md5sum file instance_host instance_volume + my $val_string = join('',@validation); + print "$val_string"; + + + # Decide what to do + + ## This block attempts to find an out-of-nebulous instance with a good md5sum, + ## and substitutes it for the 0-th listed instance. This gives us one good + ## copy to work with. + if ($Ngood == 0) { + # DO something to attempt to fix this. + my $deneb_key = $key; $deneb_key =~ s/.*?gpc/gpc/; + + open(DD,"/home/panstarrs/ipp/local/bin/deneb-locate.py $deneb_key 2> /dev/null |"); + my $good_file = ''; + while (
) { + $_ =~ s/^\s+//; + my ($z,undef,$ff) = split /\s+/; + if (($ff)&&(-e $ff)) { + my $md_response = `md5sum $ff`; + if ($md_response =~ /$md5sum/) { + $good_file = (split /\s+/,$md_response)[1]; + } + } + } + close(DD); + if ($good_file eq '') { + die "No valid instance of key: $key"; + } + else { + print "cp $good_file $files[0]\n"; + if ($do_ops) { + system("cp $good_file $files[0]"); + } + } + # Begin my best validation thought + { + my $tmpmd5 = local_md5sum($files[0]); + if ($tmpmd5 ne $md5sum) { + die "Post-replication md5sum does not match! $tmpmd5 != $md5sum"; + } + } + # End my best validation thought. + + $Ngood = 1; # We now hand off this single valid instance object to be handled by the Ngood=1 case. + ## We've done work here, so we can't do a cull this iteration. + if ($do_cull == 1) { $do_cull = -1; } + } + + ## We have more than zero bad copies. We may cull some of these in the future, but we should try to + ## leave everything in the best state possible. + printf(">> %d %d\n",$Ngood, $#files + 1); +# if ($Ngood != $#files + 1) { + if ($Nbad > 0) { + my $good_copy; + my $good_copy_index; + foreach my $site_key (keys %good_instances) { + if ($#{ $good_instances{$site_key} } != -1) { + $good_copy_index = $good_instances{$site_key}[0]; + $good_copy = $files[$good_copy_index]; + last; + } + } + printf(">> GOOD: $good_copy\n"); + foreach my $site_key (keys %bad_instances) { + foreach my $bad_copy_index (@{ $bad_instances{$site_key} }) { + print "cp $good_copy $files[$bad_copy_index]\n"; + if ($do_ops) { + system("cp $good_copy $files[$bad_copy_index]"); + } + my $tmpmd5 = local_md5sum($files[$bad_copy_index]); + if ($tmpmd5 ne $md5sum) { + ## This isn't super critical, so we don't need to die here. + warn "Post-repair md5sum does not match! $tmpmd5 != $md5sum: $files[$bad_copy_index]"; + } + else { + ## success + push @{ $good_instances{$site_key} }, $bad_copy_index; + } + } + } + ## We've done work here, so we can't do a cull this iteration. + if ($do_cull == 1) { $do_cull = -1; } + } + + #unsafe + foreach my $site_key (keys %good_instances_unchecked) { + push @{ $good_instances{$site_key} }, @{ $good_instances_unchecked{$site_key} }; + } + #end unsafe + + ## We can now attempt to make replicated copies to the sites that require additional copies. + foreach my $site_key (keys %requirement_map) { + my $have_instances = $#{ $good_instances{$site_key} } + 1; + print "## $site_key $have_instances $requirement_map{$site_key}\n"; + if ($#{ $good_instances{$site_key} } + 1 < $requirement_map{$site_key}) { + my $rep_vol = get_random_site_volume($site_key); + print "neb-replicate --volume $rep_vol $key\n"; + if ($do_ops) { + $neb->replicate($key,$rep_vol) or die "failed to replicate the single valid copy to the backup node"; + if ($@) { die $@; } + + # Begin my best validation thought + system("sync") == 0 or die "Couldn't sync?"; + my $uris = $neb->find_instances($key,$rep_vol); + @$uris = map {URI->new($_)->file if $_} @$uris; + my $tmpmd5 = local_md5sum(${ $uris }[0]); + + my $validation_str = sprintf("% 3d %d %32s %s %s %s", + -1,-1,$tmpmd5, + ${ $uris }[0],"repl",$rep_vol); + print + join("\n" . " " x 4, $validation_str), "\n"; + + if ($tmpmd5 ne $md5sum) { + die "Post-replication md5sum does not match! $tmpmd5 != $md5sum"; + } + # End my best validation thought. + } + ## We've done work here, so we can't do a cull this iteration. + if ($do_cull == 1) { $do_cull = -1; } + } + } + + ## Do culls if that's what we were going to do. + if ($do_cull == -1) { + die "Cull option passed, but files were modified in the scan/repair/replicate phase. Not running cull!\n"; + } + elsif ($do_cull == 1) { + ## At this point, we should have no files in the bad_instances lists, because we've repaired them. + foreach my $site_key (keys %good_instances) { + if ($#{ $good_instances{$site_key} } + 1 > $requirement_map{$site_key}) { + for ($i = $requirement_map{$site_key}; $i <= $#{ $good_instances{$site_key} }; $i++) { + my $cull_index = ${ $good_instances{$site_key} }[$i]; + my ($instance_host,$instance_volume) = parse_volume($files[$cull_index]); + print "neb-cull --volume $instance_volume $key\n"; + if ($do_ops) { + # The tilde here is to force hard volumes. Don't touch it. + # Also: the 2 is a "minimum number of copies" restriction. Let's not be crazy here. + $neb->cull($key,"~${instance_volume}",2) or die "failed to cull a superfluous instance"; + if ($@) { die "$@"; } + } + } # End loop over extra instances + } # End check for sites with extra instances + } # End loop over sites. + } # End cull + +} ## End loop over imfiles. + +sub local_md5sum { + my $filename = shift; + my $volume = (split /\//, $filename)[2]; + my $host = $volume; + $host =~ s/\.\d//; +# print "$filename $host $volume\n"; + my $response = `ssh $host remote_md5sum.pl $filename`; + chomp($response); + my ($sum, undef) = split /\s+/, $response; + unless(defined($sum)) { + my_die("Failed to calculate md5sum locally. $filename $host $volume"); + } + return($sum); +} + + +sub parse_volume { + my $filename = shift(@_); + my $full_volume = (split /\//, $filename)[2]; + my ($hostname,undef) = split /\./, $full_volume; # /; + return($hostname,$full_volume); +} + +sub get_random_site_volume { + my $site_key = shift(@_); + my $NN = scalar @{ $volume_lists{$site_key} }; + my $backup_volume = ${ $volume_lists{$site_key} }[int(rand($NN))]; + return($backup_volume); +} + +sub my_die { + my $msg = shift(@_); + print $msg . "\n"; + foreach my $a (@_) { + print "ARG: $a\n"; + } + die; +} + + + + + + + + + + + + + + + + + + + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rawcheck_mddb.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rawcheck_mddb.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rawcheck_mddb.pl (revision 41105) @@ -0,0 +1,720 @@ +#!/usr/bin/env perl + +use strict; +use warnings FATAL => qw( all ); + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Nebulous::Client; + +use Getopt::Long qw( GetOptions :config auto_help auto_version ); +use Pod::Usage qw( pod2usage ); +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Digest::MD5; +use URI; + +my $missing_tools = 0; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); + +my ($neb_server,$md_server,$dbname,$dbuser,$dbpass,$exp_id,$do_cull,$do_revalidate,$save_log); + + +my $do_ops = 1; +my $i; + +my $ipprc = PS::IPP::Config->new( "GPC1" ) or die "Could not create config object.\n"; +my $siteConfig = $ipprc->{_siteConfig}; +$dbuser = metadataLookupStr($ipprc->{_siteConfig}, "DBUSER"); +$dbpass = metadataLookupStr($ipprc->{_siteConfig}, "DBPASSWORD"); + +$neb_server = $ENV{'NEB_SERVER'} unless $neb_server; + +# $dbname = 'gpc1'; +GetOptions( + 'neb_server|s=s' => \$neb_server, # This is the apache server + 'md_server|s=s' => \$md_server, # This is the actual database server + 'dbname=s' => \$dbname, + 'dbuser=s' => \$dbuser, + 'dbpass=s' => \$dbpass, + 'exp_id|x=s' => \$exp_id, + 'save_log' => \$save_log, + 'cull' => \$do_cull, + 'revalidate' => \$do_revalidate, +) || pod2usage( 2 ); + +unless(defined($do_cull)) { + $do_cull = 0; +} +unless(defined($do_revalidate)) { + $do_revalidate = 0; +} +if (($do_cull == 1)&&($do_revalidate == 1)) { + pod2usage( -msg => "Only one of --cull and --revalidate may be chosen.", -exitval => 2 ); +} + + +# Option parsing +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --neb_server (apache server)", -exitval => 2 ) + unless $neb_server; +pod2usage( -msg => "Required options: --md_server (database server)", -exitval => 2 ) + unless $md_server; +pod2usage( -msg => "Required options: --dbname", -exitval => 2 ) + unless defined $dbname; +pod2usage( -msg => "Required options: --dbuser", -exitval => 2 ) + unless defined $dbuser; +pod2usage( -msg => "Required options: --dbpass", -exitval => 2 ) + unless defined $dbpass; +pod2usage( -msg => "missing key", exitval => 2 ) + unless defined $exp_id; + +if ($save_log) { + my $logDest = "neb://any/raw_check_mddb/exp_${exp_id}"; + if ($do_cull) { + $logDest .= ".cull"; + } + elsif ($do_revalidate) { + $logDest .= ".revalidate"; + } + else { + $logDest .= ".check"; + } + + $ipprc->redirect_to_logfile($logDest) or die "Could not redirect output to logfile ${logDest}\n"; +} + +# Global options: +## Define the configuration. Ideally, this would be retrieved from the nebulous +## database, but there are some issues with that (such as grouping the b nodes +## into a less restrictive "offsite" location). + +## Set up nebulous db interface, and pull processing information to consider. +my $neb = Nebulous::Client->new( + proxy => "$neb_server", +); +die "can't connected to Nebulous Server: $neb_server" + unless defined $neb; + +## Set up md5 db interface +my $mddb = DBI->connect("DBI:mysql:database=otaMD5;host=${md_server};" . + "mysql_socket=/var/run/mysqld/mysqld.sock", + ${dbuser},${dbpass}, + { RaiseError => 1, AutoCommit => 1} + ) or die "Unable to connect to database $DBI::errstr\n"; + +## This new implementation is somewhat messy, but is more general and adaptable. +## First, we set up a requirement mapping, explaining where we want copies, and +## how many copies we want at each site. +my %requirement_map = (); +$requirement_map{ITC} = 1; +$requirement_map{OFFSITE} = 1; + +## Second, construct a list of volumes, mapped to their site location, using the +## same site locations as in the requirement map. +my %volume_map = (); +for ($i = 32; $i <= 32; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'ITC'; +} +for ($i = 54; $i <= 97; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'ITC'; +} +for ($i = 100; $i <= 126; $i++) { + my $vol = sprintf("ipp%03d.0",$i); + $volume_map{$vol} = 'ITC'; + $vol = sprintf("ipp%03d.1",$i); + $volume_map{$vol} = 'ITC'; +} + +for ($i = 0; $i <= 15; $i++) { + my $loc = 'OFFSITE'; +# if ($i == 6) { +# $loc = 'ITC'; +# } # This isn't "offsite", it's with the rest of the maui cluster. +# if ($i == 9) { next; } # Not online + + my $vol = sprintf("ippb%02d.0",$i); + $volume_map{$vol} = $loc; + $vol = sprintf("ippb%02d.1",$i); + $volume_map{$vol} = $loc; + if ($i <= 6) { + $vol = sprintf("ippb%02d.2",$i); + $volume_map{$vol} = $loc; + } +} + +## Next, get disk space values, and check which hosts are listed as available. +my %acceptable_volume = (); +my $mounts = $neb->mounts(); +my %volume_fill_factors = (); +my %down_volume = (); +foreach my $vol_row (@$mounts) { + my ($mount_point, $total, $used, $vol_id, $name, $host, $path, $allocate, $available, $xattr) = @{ $vol_row }; + if (($allocate == 1)&&($available == 1)&&( $used / $total < 0.98)) { + $acceptable_volume{$name} = 1; + } + else { +# print "## $name $allocate $available $used $total\n"; + $acceptable_volume{$name} = 0; + } + + if (($available != 1)&&($xattr != 5)) { + $down_volume{$name} = 1; + } + else { + $down_volume{$name} = 0; + } + + if (($name =~ /ippb05/)||($name =~ /ippb02/)) { + $acceptable_volume{$name} = 0; + } + + $volume_fill_factors{$name} = $used / $total; + + # This should prioritize hosts that we wish to deprecate. + if ($total < 52885172852) { + $volume_fill_factors{$name} = 1.0; + } +} + +## Finally, generate lists containing which volumes are located at which site. +## This allows us to randomly select a volume from the list for the site that +## we plan on replicating to. +my %volume_lists = (); +foreach my $vol_key (keys %requirement_map) { + @{ $volume_lists{$vol_key} } = grep { $acceptable_volume{$_} == 1 } ( + grep { $volume_map{$_} eq $vol_key } (keys %volume_map) + ); + print "#$vol_key " . join(' ', @{ $volume_lists{$vol_key} }) . "\n"; + + if ($#{ $volume_lists{$vol_key} } == -1) { + die "No acceptable volume found for site $vol_key!\n"; + } +} + +# die; +# Pull data from the gpc1 database about the exposure to consider + +my $verbose = 0; +my $mdcParser = PS::IPP::Metadata::Config->new; + +print("#$regtool -processedimfile -exp_id $exp_id -dbname $dbname\n"); +my $regtool_cmd = "$regtool -processedimfile -exp_id $exp_id -dbname $dbname"; +my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $regtool_cmd, verbose => 0); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform regtool -processedimfile: $error_code", $exp_id); +} +my $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("Unable to parse metadata from regtool -processedimfile", $exp_id); + +my $timer_start = time(); +my $timer = time(); +print "## rawcheck.pl: $exp_id $dbname $do_cull $do_ops $timer_start\n"; +# Do prescan checks. +if ($#{ $imfiles } > 0) { + my @to_do_imfiles = (); + my $prior_imfile; + my $append = 0; + + foreach my $imfile (@$imfiles) { + my $key = $imfile->{uri}; + my $data_state = $imfile->{data_state}; + my $md5sum = $imfile->{md5sum}; + my $hostname = $imfile->{hostname}; + my $class_id = $imfile->{class_id}; + + unless(defined($key)) { die "No database uri: $exp_id"; } + unless(defined($data_state)) { $data_state = 'no_data_state'; } + if ($data_state eq 'corrupt') { next; } # This has already been marked as bad, so we can move on. + unless(defined($md5sum)) { die "No database md5sum: $exp_id"; } + unless(defined($hostname)) { $hostname = 'ipp004'; } + unless(defined($class_id)) { die "No database class_id: $class_id"; } + + # This hash contains all the information about the instances, indexed by the full filename of the instance. + my %unified_list = (); + my %orphans = (); + + $timer = time(); + print ("\n# $key $data_state $md5sum $hostname $class_id T: $timer\n"); + + # Get nebulous results for this key, and parse them + my $stat = $neb->stat($key); + die "nebulous key: $key not found" unless $stat; + my $instances = $neb->find_instances($key, 'any'); + die "no instances found" unless $instances; + my @files = map {URI->new($_)->file if $_} @$instances; + + for (my $i = 0; $i <= $#files; $i++) { + my $f = $files[$i]; + $f =~ s%//%/%g; + my ($instance_exists,$instance_host,$instance_volume,$instance_site); + ($instance_host,$instance_volume) = parse_volume($files[$i]); + $instance_site = $volume_map{$instance_volume}; + if (-e $f) { + $instance_exists = 1; + } + else { + $instance_exists = 0; + } + $unified_list{$f}{neb_host} = $instance_host; + $unified_list{$f}{neb_vol} = $instance_volume; + $unified_list{$f}{neb_site} = $instance_site; + $unified_list{$f}{exists} = $instance_exists; + } + + # Get md database results for this exp_id/class_id + my $md_query = "select file_id,ins_id,mvol_name,site_name,file,disk_sum,(STRCMP(md5sum,disk_sum) = 0) AS is_valid FROM obj LEFT JOIN ins USING(file_id) LEFT JOIN vol USING(mvol_id) WHERE exp_id = $exp_id AND class_id = '${class_id}'"; + my $md_instances = $mddb->selectall_arrayref( $md_query ); + + $timer = time(); +# print "##NEB $timer\n"; + my $md_file_id = -1; + foreach my $r (@{ $md_instances }) { + my ($file_id,$ins_id,$vol_name,$site_name,$f,$disk_sum,$is_valid) = @{ $r }; + + if ((defined($f))&&(defined($ins_id))) { + $f =~ s%//%/%g; + unless (exists($unified_list{$f})) { + if (-e $f) { + $unified_list{$f}{exists} = 1; + } + else { + $unified_list{$f}{exists} = 0; + } + } + # This should only happen if the same scan was ingested twice. + # Be paranoid and refuse to cull if this is the case. + if (exists($unified_list{$f}{md_ins_id})) { + if (($file_id == $unified_list{$f}{md_file_id})&& + ($vol_name eq $unified_list{$f}{md_vol})&& + ($site_name eq $unified_list{$f}{md_site})&& + ($disk_sum eq $unified_list{$f}{disk_sum})&& + ($is_valid == $unified_list{$f}{is_valid})) { + print "#DUPLICATE INS: $ins_id have $unified_list{$f}{md_ins_id} already\n"; + mddb_delete_instance($mddb,$ins_id); + $do_cull = -1; + next; + } + else { + # The data is inconsistent. Make a human fix it. + print "INS ERROR: $f -> \n"; + print "\t($file_id $ins_id $vol_name $site_name $disk_sum $is_valid)\n"; + print "\t($unified_list{$f}{md_file_id} $unified_list{$f}{md_ins_id} $unified_list{$f}{md_vol} $unified_list{$f}{md_site} $unified_list{$f}{disk_sum} $unified_list{$f}{is_valid})\n"; + die; + } + } + + $unified_list{$f}{md_file_id} = $file_id; + $unified_list{$f}{md_ins_id} = $ins_id; + $unified_list{$f}{md_vol} = $vol_name; + $unified_list{$f}{md_site} = $site_name; + $unified_list{$f}{disk_sum} = $disk_sum; + $unified_list{$f}{is_valid} = $is_valid; + } + + if (defined($file_id)) { + if ($md_file_id == -1) { + $md_file_id = $file_id; + } + elsif ($file_id != $md_file_id) { + die "Instance $ins_id has bad file_id $file_id expected $md_file_id"; + } + } + } + if ($md_file_id == -1) { + # There is no md information for this exposure + $md_file_id = mddb_create_file($mddb,$key,$exp_id,$class_id,$md5sum); + $do_cull = -1; + } + + $timer = time(); +# print "##MD $timer\n"; + + # Check that evrything is consistent. + my $good_copies = 0; + my $all_copies = scalar(keys(%unified_list)); + my $a_good_copy = ''; + + my %instance_count = (); + foreach my $site (keys(%requirement_map)) { + $instance_count{$site} = 0; + } + + foreach my $f (keys(%unified_list)) { + $unified_list{$f}{good_instance} = 0; + print "$f "; + + # Identify orphans, and push their handling until later. + unless (exists($unified_list{$f}{neb_host})) { + if ($down_volume{$unified_list{$f}{md_vol}} != 1) { + # Handle this. + $orphans{$f} = $unified_list{$f}; + warn "No neb entry for $orphans{$f}{md_ins_id} $exp_id $class_id $f \n"; + } + else { + warn "No neb entry for likely due to host issue $exp_id $class_id $f \n"; + } + delete($unified_list{$f}); + next; + } + print "$unified_list{$f}{neb_host} $unified_list{$f}{neb_vol} $unified_list{$f}{neb_site} $unified_list{$f}{exists} "; + + + # Create an entry in the mddb database if that doesn't already exist. + unless (exists($unified_list{$f}{md_vol})) { + # Insert a new row in the mddb ins table for this instance. + if ($unified_list{$f}{exists} != 1) { + # Ensure that the file exists, so an md5sum can be performed. + system("touch $f"); + } + my $tmpmd5 = local_md5sum($f); + my ($ins_id, $site_name) = mddb_insert_instance($mddb,$md_file_id,$f, $unified_list{$f}{neb_vol}, $tmpmd5); + + $unified_list{$f}{md_vol} = $unified_list{$f}{neb_vol}; + $unified_list{$f}{md_site} = $site_name; + $unified_list{$f}{disk_sum} = $tmpmd5; + $unified_list{$f}{md_file_id} = $md_file_id; + $unified_list{$f}{md_ins_id} = $ins_id; + + if ($tmpmd5 ne $md5sum) { + # Insert even if we fail so we can try fixing next time. + # This may cause a problem if the first instance we checked has a bad md5sum. + warn "Post-replication md5sum does not match! $tmpmd5 != $md5sum"; + $unified_list{$f}{is_valid} = 0; + } + else { + $unified_list{$f}{is_valid} = 1; + } + } + + # This will force md5sum calculations to everything, so disk<->mddb consistency can be checked. + if ($do_revalidate) { + my $tmpmd5 = local_md5sum($f); + print "REVALIDATE: ($tmpmd5) "; + if ($tmpmd5 ne $unified_list{$f}{disk_sum}) { + mddb_update_instance($mddb,$unified_list{$f}{md_ins_id}, $tmpmd5); + warn "Updated instance $unified_list{$f}{md_ins_id} to $tmpmd5\n"; + } + if ($tmpmd5 ne $md5sum) { + warn "Revalidated md5sum does not match!"; + } + } + + print "$unified_list{$f}{md_file_id} $unified_list{$f}{md_ins_id} $unified_list{$f}{md_vol} $unified_list{$f}{md_site} $unified_list{$f}{disk_sum} $unified_list{$f}{is_valid} "; + + + if ($unified_list{$f}{exists} != 1) { + warn "Instance does not exist $exp_id $class_id $f\n"; + next; + } + if ($unified_list{$f}{neb_vol} ne $unified_list{$f}{md_vol}) { + die "Inconsistent volumes for $exp_id $class_id $f $unified_list{$f}{neb_vol} $unified_list{$f}{md_vol}\n"; + } + if ($unified_list{$f}{is_valid} != 1) { + warn "Instance is not valid $exp_id $class_id $f\n"; + next; + } + if ($unified_list{$f}{disk_sum} ne $md5sum) { + # This is a die, because if the gpc1 md5sum and the mddb md5sum don't match, there's a problem + die "Inconsistent md5sum values $exp_id $class_id $f $md5sum $unified_list{$f}{disk_sum}\n"; + } + + # If none of that stopped us, then this instance is probably fine. + $unified_list{$f}{good_instance} = 1; + $instance_count{$unified_list{$f}{neb_site}} ++; + $good_copies++; + if ($a_good_copy eq '') { + $a_good_copy = $f; + } + print "$unified_list{$f}{good_instance}"; + print "\n"; + } + + if ($good_copies == 0) { + my $orphan_copy = ''; + foreach my $orph (keys (%orphans)) { + if ($orphans{$orph}{is_valid} == 1) { + $orphan_copy = $orph; + } + } + + if ($orphan_copy eq '') { + die "No good copies available for $exp_id $class_id\n"; + } + else { + die "No good copies available for $exp_id $class_id (but $orphan_copy may exist)\n"; + } + } + + $timer = time(); +# print "##CHECK $timer\n"; + + # Attempt to repair any bad instance. + print "COUNT CHECK $good_copies $all_copies\n"; + if ($good_copies != $all_copies) { + foreach my $f (keys(%unified_list)) { + if ($unified_list{$f}{good_instance} != 1) { + system("cp $a_good_copy $f"); + my $tmpmd5 = local_md5sum($f); + if ($tmpmd5 ne $md5sum) { + die "Post-replication md5sum does not match! $tmpmd5 != $md5sum"; + } + + mddb_update_instance($mddb,$unified_list{$f}{md_ins_id}, $tmpmd5); + + $do_cull = -1; + $unified_list{$f}{good_instance} = 2; + $unified_list{$f}{disk_sum} = $tmpmd5; + $instance_count{$unified_list{$f}{neb_site}} ++; + $good_copies++; + + # Print out the same information as before, but updated to show the repair. + print "$f "; + print "$unified_list{$f}{neb_host} $unified_list{$f}{neb_vol} $unified_list{$f}{neb_site} $unified_list{$f}{exists} "; + print "$unified_list{$f}{md_file_id} $unified_list{$f}{md_ins_id} $unified_list{$f}{md_vol} $unified_list{$f}{md_site} $unified_list{$f}{disk_sum} $unified_list{$f}{is_valid} "; + print "$unified_list{$f}{good_instance}"; + print "\n"; + } + } + } + + # We cannot reach this point if good_copies != all_copies. + + # Do replications + foreach my $site (keys %requirement_map) { + print "#$site $instance_count{$site} $requirement_map{$site}\n"; + if ($instance_count{$site} < $requirement_map{$site}) { + my $rep_vol = get_random_site_volume($site); + print "neb-replicate --volume $rep_vol $key\n"; + $do_cull = -1; + + if ($do_ops) { + $neb->replicate($key,$rep_vol) or die "failed to replicate $key to $rep_vol"; + if ($@) { die $@; } + + # Begin my best validation thought + system("sync") == 0 or die "Couldn't sync?"; + my $uris = $neb->find_instances($key,$rep_vol); + @$uris = map {URI->new($_)->file if $_} @$uris; + my $f = ${ $uris }[0]; + my $tmpmd5 = local_md5sum($f); + if ($tmpmd5 ne $md5sum) { + die "Post-replication md5sum does not match! $tmpmd5 != $md5sum"; + } + # End my best validation thought. + + # Report on the replicated instance. + my ($ins_id, $site_name) = mddb_insert_instance($mddb,$md_file_id,$f, $rep_vol, $tmpmd5); + $unified_list{$f}{md_vol} = $rep_vol; + $unified_list{$f}{md_site} = $site_name; + $unified_list{$f}{disk_sum} = $tmpmd5; + $unified_list{$f}{is_valid} = 1; + $unified_list{$f}{md_file_id} = $md_file_id; + $unified_list{$f}{md_ins_id} = $ins_id; + + my ($instance_host,$instance_volume) = parse_volume($f); + my $instance_site = $volume_map{$instance_volume}; + $unified_list{$f}{neb_host} = $instance_host; + $unified_list{$f}{neb_vol} = $instance_volume; + $unified_list{$f}{neb_site} = $instance_site; + $unified_list{$f}{exists} = 1; + $unified_list{$f}{good_instance} = 1; + + print "$f "; + print "$unified_list{$f}{neb_host} $unified_list{$f}{neb_vol} $unified_list{$f}{neb_site} $unified_list{$f}{exists} "; + print "$unified_list{$f}{md_file_id} $unified_list{$f}{md_ins_id} $unified_list{$f}{md_vol} $unified_list{$f}{md_site} $unified_list{$f}{disk_sum} $unified_list{$f}{is_valid} "; + print "$unified_list{$f}{good_instance}"; + print "\n"; + } + } + } # End replicating + + # Do culls + if ($do_cull == 1) { + foreach my $site (keys %requirement_map) { + if ($instance_count{$site} > $requirement_map{$site}) { + my @cull_order = (); + my %sorting_hash = (); + for my $f (keys %unified_list) { + if ($unified_list{$f}{neb_site} eq $site) { + push @cull_order, $f; + $sorting_hash{$f} = $volume_fill_factors{$unified_list{$f}{neb_vol}}; + } + } + @cull_order = sort { $sorting_hash{$b} <=> $sorting_hash{$a} } @cull_order; + +# my $tmp = join ' ', @cull_order; +# print "$exp_id $site $tmp\n"; + for ($i = 0; $i < ($instance_count{$site} - $requirement_map{$site}); $i++) { + my $f = $cull_order[$i]; + my $instance_volume = $unified_list{$f}{neb_vol}; + print "neb-cull --volume $instance_volume $key\n"; + print "$f $unified_list{$f}{md_ins_id}\n"; + if ($do_ops) { + # The tilde here is to force hard volumes. Don't touch it. + # Also: the 2 is a "minimum number of copies" restriction. Let's not be crazy here. + $neb->cull($key,"~${instance_volume}",2) or die "failed to cull a superfluous instance"; + if ($@) { die "$@"; } + mddb_delete_instance($mddb,$unified_list{$f}{md_ins_id}); + } + } + } + } + + # If we're here, then we've sucessfully sorted out this instance. + foreach my $f (keys %orphans) { + print "ORPHAN $f $orphans{$f}{md_ins_id}\n"; + mddb_delete_instance($mddb,$orphans{$f}{md_ins_id}); +# unlink($f) or warn "Could not unlink $f: $!"; + } + + } # End culling + + } # End scan over imfiles +} # End check for gpc1 database entry +# End prescan checks. +if ($do_cull == -1) { + die "Could not cull after repairing a file.\n"; +} + +# mddb_create_file($mddb,$key,$exp_id,$class_id,$md5sum); +sub mddb_create_file { + my $db = shift; + my $key = shift; + my $exp_id = shift; + my $class_id = shift; + my $md5sum = shift; + + my $query = "INSERT INTO obj (neb_key, exp_id, class_id, md5sum) VALUES (?, ?, ?, ?)"; + $db->do("BEGIN"); + my $stmt = $db->prepare($query); + $stmt->execute($key,$exp_id,$class_id,$md5sum) or + &my_die("failed to insert obj with new file $key $exp_id $class_id $md5sum"); + $stmt->finish(); + $db->do("COMMIT"); + + $query = "SELECT file_id FROM obj WHERE exp_id = $exp_id AND class_id = '$class_id'"; + my $md_instances = $mddb->selectall_arrayref( $query ); + my $row = ${ $md_instances }[0]; + my $file_id = ${ $row }[0]; + return($file_id); +} + +sub mddb_update_instance { + my $db = shift; + my $ins_id = shift; + my $disk_sum = shift; + + my $query = "UPDATE ins SET disk_sum = ? WHERE ins_id = ?"; + $db->do("BEGIN"); + my $stmt = $db->prepare($query); + $stmt->execute($disk_sum,$ins_id) or + &my_die("failed to update ins with new sum $ins_id $disk_sum"); + $stmt->finish(); + $db->do("COMMIT"); +} + +sub mddb_insert_instance { + my $db = shift; + my $file_id = shift; + my $file = shift; + my $volume = shift; + my $disk_sum = shift; + + my $query = "INSERT INTO ins (file_id, file, mvol_id, disk_sum) SELECT ?, ?, mvol_id, ? FROM vol WHERE vol.mvol_name = ?"; + $db->do("BEGIN"); + my $stmt = $db->prepare($query); + $stmt->execute($file_id,$file,$disk_sum,$volume) or + &my_die("failed to insert ins with new instance $file_id $file $volume $disk_sum"); + $stmt->finish(); + $db->do("COMMIT"); + + $query = "SELECT ins_id, site_name FROM ins JOIN vol USING(mvol_id) WHERE file_id = $file_id AND file = '$file'"; + my $md_instances = $mddb->selectall_arrayref( $query ); + my $row = ${ $md_instances }[0]; + my $ins_id = ${ $row }[0]; + my $site_name = ${ $row }[1]; + return($ins_id, $site_name); +} + +sub mddb_delete_instance { + my $db = shift; + my $ins_id = shift; + + print "DELETE $ins_id\n"; + my $query = "DELETE FROM ins WHERE ins_id = ?"; + $db->do("BEGIN"); + my $stmt = $db->prepare($query); + $stmt->execute($ins_id) or + &my_die("failed to delete ins entry $ins_id"); + $stmt->finish(); + $db->do("COMMIT"); +} + +sub local_md5sum { + my $filename = shift; + my $volume = (split /\//, $filename)[2]; + my $host = $volume; + $host =~ s/\.\d//; +# print "$filename $host $volume\n"; + my $response = `ssh $host remote_md5sum.pl $filename`; + chomp($response); + my ($sum, undef) = split /\s+/, $response; + unless(defined($sum)) { + my_die("Failed to calculate md5sum locally. $filename $host $volume"); + } + return($sum); +} + +sub parse_volume { + my $filename = shift(@_); + my $full_volume = (split /\//, $filename)[2]; + my ($hostname,undef) = split /\./, $full_volume; # /; + return($hostname,$full_volume); +} + +sub get_random_site_volume { + my $site_key = shift(@_); + my $NN = scalar @{ $volume_lists{$site_key} }; + my $backup_volume = ${ $volume_lists{$site_key} }[int(rand($NN))]; + return($backup_volume); +} + +sub my_die { + my $msg = shift(@_); + print $msg . "\n"; + foreach my $a (@_) { + print "ARG: $a\n"; + } + die; +} + + + + + + + + + + + + + + + + + + + + +__END__ + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rcserver_checkstatus.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rcserver_checkstatus.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/rcserver_checkstatus.pl (revision 41105) @@ -0,0 +1,119 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Digest::MD5::File qw( file_md5_hex ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Look for programs we need +my $missing_tools; +my $disttool = can_run('disttool') or (warn "Can't find disttool" and $missing_tools = 1); +my $dsproductls = can_run('dsproductls') or (warn "Can't find dsproductls" and $missing_tools = 1); +my $wget = can_run('wget') or (warn "Can't find wget" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($dest_id, $status_uri, $last_fileset, $limit); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); + +GetOptions( + 'dest_id=s' => \$dest_id, # destination identifier + 'status_uri=s' => \$status_uri, # uri for the desination's status data store product + 'last_fileset=s' => \$last_fileset, # name of last fileset seen on this datastore + 'limit=i' => \$limit, # limit on the number of filesets to process + 'dbname=s' => \$dbname, # Database name + 'save-temps' => \$save_temps, # Save temporary files? + 'verbose' => \$verbose, # Print stuff? + 'no-update' => \$no_update, # Don't update the database + 'logfile=s' => \$logfile, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --dest_id --status_uri", + -exitval => 3) unless + defined $dest_id and + defined $status_uri; + +$ipprc->redirect_output($logfile) if $logfile; + +my $url = "$status_uri/index.txt"; +$url .= "?$last_fileset" if defined($last_fileset) and ($last_fileset ne "NULL"); + +my @fileset_list; +{ + # XXX TODO: use dsproductls once it's been updated to output product type specific columns + my $command = "$wget --no-verbose -O - $url"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $dest_id, $error_code); + } + + @fileset_list = split "\n", join "", @$stdout_buf; + + my $numlines = scalar @fileset_list; +} + +my $numFilesets = 0; +foreach my $line (@fileset_list) { + # skip comment lines + next if $line =~ /^#/; + $numFilesets++; + last if $limit and ($numFilesets > $limit); + + my ($status_fs_name, $time, $type, $fs_name, $fault) = split /\|/, $line; + + my $command = "$disttool -updatercrun -dest_id $dest_id -fs_name $fs_name -status_fs_name $status_fs_name -set_last_fileset $status_fs_name -fault $fault"; + if ($fault == 0) { + $command .= " -set_state full"; + } + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $dest_id, $error_code); + } +} + + + +sub my_die { + my $msg = shift; + my $dest_id = shift; + my $fault = shift; + + die "$msg dest_id: $dest_id: $fault"; + + exit $fault; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_advance.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_advance.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_advance.pl (revision 41105) @@ -0,0 +1,149 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use Carp; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $receivetool = can_run('receivetool') or (warn "Can't find receivetool" and $missing_tools = 1); +my $receive_setstatus = can_run('receive_setstatus.pl') or (warn "Can't find receive_setstatus.pl" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ( $fileset_id, $fileset, $dbinfo_uri, $product, $ds_dbname, $ds_dbhost, $dbname, $verbose, $no_update, $save_temps ); + +GetOptions( + 'fileset_id=s' => \$fileset_id,# database id for the fileset + 'fileset=s' => \$fileset, # fileset name + 'dbinfo_uri=s' => \$dbinfo_uri,# uri for the database info file + 'status_product=s' => \$product, # Product for status update + 'ds_dbname=s' => \$ds_dbname, # data store host + 'ds_dbhost=s' => \$ds_dbhost, # data store dbname + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --file_id --source --product --fileset --file --workdir", + -exitval => $PS_EXIT_CONFIG_ERROR) unless + defined $fileset_id; + +my $ipprc = PS::IPP::Config->new() or + &my_die( "Unable to set up", $fileset_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $import_run_to_db = 0; +if ($import_run_to_db and $dbinfo_uri and ($dbinfo_uri ne "NULL")) { + my $filename = basename($dbinfo_uri); + my ($stage) = $filename =~ m|^dbinfo\.(\S+)\.\d+\.mdc$|; # Stage of interest + my $tool_name; + my $tool_mode = '-importrun'; + if ($stage eq "raw") { + $tool_name = "regtool"; + } elsif ($stage eq "camera") { + $tool_name = "camtool"; + } elsif ($stage eq "chip_bg" or $stage = "warp_bg") { + $tool_name = "bgtool"; + } elsif ($stage eq "sky") { + $tool_name = "staticskytool"; + } elsif ($stage eq "skycal") { + $tool_name = "staticskytool"; + $tool_mode = '-importskycal'; + } else { + $tool_name = "${stage}tool"; + } + my $tool = can_run("$tool_name") or &my_die("Can't find tool to load $dbinfo_uri\n", $fileset_id, $PS_EXIT_CONFIG_ERROR); + + my $file = $ipprc->file_resolve($dbinfo_uri); + &my_die("Unable to resolve $dbinfo_uri\n", $PS_EXIT_UNKNOWN_ERROR) unless $file; + + my $command = "$tool $tool_mode -infile $file"; # Command to execute + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die("Unable to load $file\n", $fileset_id, $PS_EXIT_UNKNOWN_ERROR) unless $success; + + # XXX: once the dbinfo file is imported we cannot revert this fileset +} + +if ($product and ($product ne 'NULL')) { + my $command = "$receive_setstatus --dbname $ds_dbname --status_product $product"; + $command .= " --received_fs_name $fileset --fault 0"; + if ($ds_dbname) { + $command .= " --dbname $ds_dbname"; + } else { + # XXX: is falling back to the other database a good idea? + $command .= " --dbname $dbname" if defined $dbname; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die("Unable to set transfer status on data store for $fileset_id\n", $fileset_id, $PS_EXIT_UNKNOWN_ERROR) unless $success; +} + +# update the fileset entry +# All done +{ + my $command = "$receivetool -updatefileset -fileset_id $fileset_id -set_state full"; + $command .= " -dbname $dbname" if defined $dbname; + + unless (defined $no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die("Unable to add result for $fileset_id\n", $fileset_id, $PS_EXIT_CONFIG_ERROR) unless $success; + } +} + +# Pau. + + +sub my_die +{ + my $msg = shift; # Exit message + my $fileset_id = shift; # Fileset identifier + my $fault = shift; # Fault code + + $fault = $PS_EXIT_PROG_ERROR unless defined $fault; + + carp($msg); + if (defined $fileset_id and not $no_update) { + my $command = "$receivetool -updatefileset"; + $command .= " -fileset_id $fileset_id"; + $command .= " -fault $fault"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + } + exit $fault; +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_file.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_file.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_file.pl (revision 41105) @@ -0,0 +1,609 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use File::Temp qw( tempfile tempdir ); +use File::Basename qw( basename ); +use Carp; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $receivetool = can_run('receivetool') or (warn "Can't find receivetool" and $missing_tools = 1); +my $dsproductls = can_run('dsfilesetls') or (warn "Can't find dsfilesetls" and $missing_tools = 1); +my $gunzip = can_run('gunzip') or (warn "Can't find gunzip" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $temproot = "/tmp"; + +# Parse the command-line arguments +my ( $file_id, $source, $product, $fileset, $fileset_id, $file, $component, $bytes, $md5sum, $workdir, $dirinfo_uri, $no_extract, $dbname, $verbose, $no_update, $save_temps ); + +GetOptions( + 'file_id=s' => \$file_id, # File identifier + 'source=s' => \$source, # Source for data + 'product=s' => \$product, # Product for data + 'fileset=s' => \$fileset, # Fileset for data + 'fileset_id=s' => \$fileset_id, # database id for the fileset + 'file=s' => \$file, # File to retrieve + 'component=s' => \$component, # component for this file (class_id, skycell_id or dbinfo) + 'bytes=i' => \$bytes, # file size in bytes + 'md5sum=s' => \$md5sum, # md5sum for file from data store + 'workdir=s' => \$workdir, # Working directory for output + 'no-extract' => \$no_extract, # Do not extract the tarfiles + 'dirinfo=s' => \$dirinfo_uri, # file containing the destination directories for this component + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'save-temps' => \$save_temps, # Save temporary files? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --file_id --source --product --fileset --file --component --workdir --bytes --md5sum --dirinfo", + -exitval => $PS_EXIT_CONFIG_ERROR) unless + defined $file_id and + defined $source and + defined $product and + defined $fileset and + defined $file and + defined $component and + defined $bytes and + defined $md5sum and + defined $dirinfo_uri and + defined $workdir; + +my $tempdir = tempdir( "$temproot/receive.$file_id.XXXX", CLEANUP => !$save_temps); + +&my_die( "dirinfo is NULL for $component", $file_id, $PS_EXIT_CONFIG_ERROR ) + if (($dirinfo_uri eq "NULL") and ($component ne "dirinfo")); + +my $ipprc = PS::IPP::Config->new() or + &my_die( "Unable to set up", $file_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $mdcParser = PS::IPP::Metadata::Config->new; + +# select a directory for the dirinfo and dbinfo files +# XXX: perhaps this directory should be set by the script and passed in +# rather than computed here. + +my ($day, $month, $year) = (localtime)[3,4,5]; +my $datestr = sprintf "%04d%02d%02d", $year+1900, $month + 1, $day; +my $dir_for_info_files = caturi($workdir, $datestr, $fileset); + + +my $is_tarfile = 0; +if ($file =~ m|.*\.tgz$|) { # XXX: perhaps get this off of file type ? + $is_tarfile = 1; +} + +my $filename; +if ($is_tarfile and $no_extract) { + $filename = "$dir_for_info_files/$file"; +} else { + $filename = "$tempdir/$file"; +} + +# Retrieve file +{ + my $uri = "$source/$product/$fileset/$file"; # URI for datastore file + my $command = "dsget --uri $uri --filename $filename"; # Command to execute + $command .= " --timeout 590"; + $command .= " --bytes $bytes --md5 $md5sum"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to retrieve file from $uri\n", $file_id, $PS_EXIT_DATA_ERROR) unless $success; +} +my $mjd_copy = DateTime->now->mjd; # MJD of finishing copy + +# figure out which dirinfo file to read +my $dirinfo_file_to_read = $component eq "dirinfo" ? $filename : $dirinfo_uri; + +# process it +my ($destdir, $components, $dirinfo_lines) = read_dirinfo_file($dirinfo_file_to_read, $file_id); + + +# Deal with file +if ($component eq 'dirinfo') { + # save the dirinfo file contents into the $workdir + + $dirinfo_uri = caturi($dir_for_info_files, basename($filename)); + print "dirinfo_uri: $dirinfo_uri\n" if $verbose; + + my $resolved = $ipprc->file_resolve($dirinfo_uri, 'create'); + &my_die( "failed to resolve $dirinfo_uri\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$resolved; + + print "dirinfo resolved is: $resolved\n" if $verbose; + + open OUT, ">$resolved" + or &my_die( "failed to open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + print OUT @$dirinfo_lines + or &my_die( "failed to write $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + close OUT + or &my_die( "failed to close $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + # update the fileset to allow processing of other files + my $command = "$receivetool -updatefileset -fileset_id $fileset_id"; + $command .= " -set_state new -dirinfo $dirinfo_uri"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to update fileset $fileset_id to\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success; + } else { + print STDERR "skipping $command\n"; + } + +} elsif ($component eq "dbinfo") { + + open INFILE, $filename or &my_die( "Can't open $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + my @lines = (); + + my $dbinfo = join "", @lines; + + close INFILE; + + my $dbinfo_uri = caturi($dir_for_info_files, basename($filename)); + print "dbinfo_uri: $dbinfo_uri\n" if $verbose; + + my $resolved = $ipprc->file_resolve($dbinfo_uri, 'create'); + &my_die( "failed to resolve $dbinfo_uri\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$resolved; + + open OUT, ">$resolved" + or &my_die( "failed to open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + # We process the dbinfo file (the exported run from the distribution) line by line + # Rather than read it as an mdc and interptet it, we do our substitutions directly + # This is much faster. Parsing a mdc file for a chip run takes several seconds. + # we are very strict about the format of the file + # + # First comes the dbversion metadata + # Next comes the data for the Run + # Next is the data for each component and other associated tables + # The component_id (class_id, skycell_id) must come before any of the paths that we edit + + my $runType = findRunType(\@lines); + + my $stage; + my $comp_name; + my $current_component; + if ($runType eq 'rawExp') { + $stage = 'raw'; + $comp_name = 'class_id'; + } elsif ($runType eq 'chipBackgroundRun') { + $stage = 'chip_bg'; + $comp_name = 'class_id'; + } elsif ($runType eq 'chipRun') { + $stage = 'chip'; + $comp_name = 'class_id'; + } elsif ($runType eq 'camRun') { + $stage = 'camera'; + $comp_name = 'exposure'; + $current_component = $comp_name; + } elsif ($runType eq 'fakeRun') { + $stage = 'fake'; + $comp_name = 'class_id'; + } elsif ($runType eq 'warpRun') { + $stage = 'warp'; + $comp_name = 'skycell_id'; + } elsif ($runType eq 'warpBackgroundRun') { + $stage = 'warp_bg'; + $comp_name = 'skycell_id'; + } elsif ($runType eq 'diffRun') { + $stage = 'diff'; + $comp_name = 'skycell_id'; + } elsif ($runType eq 'stackRun') { + $stage = 'stack'; + $comp_name = 'skycell_id'; + } elsif ($runType eq 'staticskyRun') { + $stage = 'sky'; + $comp_name = 'skycell_id'; + } elsif ($runType eq 'skycalRun') { + $stage = 'skycal'; + $comp_name = 'skycell_id'; + } else { + &my_die( "unexpected run type line found in $filename: $runType\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + } + + my $new_workdir_value; + if ($destdir eq 'none') { + # this only appiles to rawExp + $new_workdir_value = "$workdir"; + } else { + $new_workdir_value = "$workdir/$destdir"; + } + + if ($stage eq 'sky' or $stage eq 'skycal') { + # the dbinfo file for staticskyRun and skycalRun only have one component and they don't contain + # skycell_id which is the way components are listed in the dirinfo file. + my @ids = keys %$components; + my $nComponents = scalar @ids; + &my_die( "unexpected number of components $nComponents found in $stage dirinfo file\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) if $nComponents != 1; + $current_component = $ids[0]; + } + + my $component_dir; + if ($current_component) { + $component_dir = $components->{$current_component}; + } + foreach my $line (@lines) { + my $out_line = $line; + + my ($name, $type, $value) = split " ", $line; + # only complete lines have things that we need to examine + if ($name and $type and $value) { + my $new_value; + # we have a new component id, save it and look up the corresponding + # component_dir + if ($name eq $comp_name) { + $current_component = $value; + $component_dir = $components->{$current_component}; + &my_die( "$component_dir is null for $value in $filename: $runType\n", + $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$component_dir; + } elsif ($name eq 'workdir') { + $new_value = $new_workdir_value; + } elsif ($name eq 'tess_id') { + # for tess_id strip off any directories just keep the basename. + # The site configuration will need to map this to a proper location + # XXX: Document this + $new_value = basename($value); + } elsif ((($name eq 'uri') or ($name eq 'path_base')) and ($value ne 'NULL')) { + &my_die( "component_dir is null and we need it for $name", + $file_id, $PS_EXIT_PROG_ERROR) if !$component_dir; + + $new_value = caturi($new_workdir_value, $component_dir, basename($value)); + } + + # if the value changed re-write the line, otherwise just print what we read + if ($new_value) { + $out_line = " " . $name . "\t\t" . $type . "\t" . $new_value . "\n"; + } + } + + print OUT $out_line or &my_die( "failed to write to $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + } + + close OUT + or &my_die( "failed to close $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + # update the fileset to allow processing of other files + my $command = "$receivetool -updatefileset -fileset_id $fileset_id"; + $command .= " -dbinfo $dbinfo_uri"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to update fileset $fileset_id to\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success; + + +} elsif ($is_tarfile and !$no_extract) { + # Get contents of tarball + my @files = (); + { + my $command = "tar -C $tempdir -tzf $filename"; # Command to execute + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get listing of tar file $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success; + + my @lines = split(/\n/, join "", @$stdout_buf); # Lines from output + foreach my $line ( @lines ) { + $line =~ s/\#.*$//; + next unless $line =~ /\S+/; + my @fields = split(/\s+/, $line); # Fields in line + my $file = $fields[0]; # Name of file + $file =~ s|^./||; + push @files, $file if $file =~ /\S+/; + } + } + + # Extract files from tarball + { + my $command = "tar -C $tempdir -xzf $filename"; # Command to execute + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to extract tar file $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success; + } + + my $component_dir = $components->{$component}; + &my_die( "Unable to find component_dir for $component $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $component_dir; + + my $target_dir; + if ($destdir eq 'none') { + $target_dir = "$workdir"; + } else { + $target_dir = "$workdir/$destdir"; + } + $target_dir .= "/$component_dir"; + + # Move files into filesystem of choice + foreach my $file ( @files ) { + my $from = "$tempdir/$file"; # Source for file + my $target = "$target_dir/$file"; # Target destination for file + + + $ipprc->file_delete ($target); + + my $to = $ipprc->file_create( $target ); # Target for move + + if (!$to) { + &my_die( "failed to create: $target\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + } + + if ( $file =~ /.+\.mdc/ ) { + # this file is a config dump file edit the paths + edit_mdc_file($file_id, $from, $to, $workdir); + } else { + system("mv $from $to") == 0 or &my_die( "Unable to move $file into workdir $workdir: $!\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + } + } +} elsif ($is_tarfile and $no_extract) { + print "skipping extraction of tarfile $filename\n"; +} else { + &my_die( "Unrecognised file: $file\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); +} + +my $mjd_extract = DateTime->now->mjd; # MJD of finishing extract + +# All done +{ + my $command = "$receivetool -addresult"; + $command .= " -file_id $file_id"; + $command .= (" -dtime_copy " . (($mjd_copy - $mjd_start) * 86400)); + $command .= (" -dtime_extract " . (($mjd_extract - $mjd_copy) * 86400)); + $command .= " -dbname $dbname" if defined $dbname; + + + print "$command\n"; + + unless (defined $no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + die "Unable to add result for $file\n" unless $success; + } +} + +# Pau. + +sub read_dirinfo_file +{ + my $filename = shift; + my $file_id = shift; + + my $resolved = $ipprc->file_resolve($filename); + &my_die("failed to resolve dirinfo file: $filename ", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$resolved; + + open INFILE, $resolved or &my_die( "Can't open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + my @lines = (); + + my $dirinfo = join "", @lines; + + close INFILE; + + my $metadata = $mdcParser->parse($dirinfo) or + &my_die("Unable to parse metadata config doc", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + my $array = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + my $dest_hash = $array->[0]; + + my $destdir = $dest_hash->{destdir}; + &my_die("destdir not found in $filename", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$destdir; + + my $components = $array->[1]; + + return ($destdir, $components, \@lines); +} + +# edit a config dump file replacing the "volume" value with the new local value: $workdir +sub edit_mdc_file +{ + my $file_id = shift; + my $src = shift; + my $dest = shift; + my $workdir = shift; + + my $filecmd_output = `file $src`; + &my_die("failed to determinte file type of $src", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$filecmd_output; + chomp $filecmd_output; + + my $tmpName; + if ($filecmd_output =~ /gzip/) { + my $tmpfile; + ($tmpfile, $tmpName) = tempfile( "/tmp/receive.XXXX", UNLINK => !$save_temps ); + close($tmpfile) or &my_die("failed to close $tmpName", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + my $command = "$gunzip -c $src > $tmpName"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $component, $error_code); + } + $src = $tmpName; + } + + open my $IN, "<$src" or &my_die("failed to open $src for input", $file_id, $PS_EXIT_UNKNOWN_ERROR); + open my $OUT, ">$dest" or &my_die("failed to open $dest for output", $file_id, $PS_EXIT_UNKNOWN_ERROR); + + # Assumed file structure + # stuff + # FILES.INPUT metadata + # FILES.OUTPUT metadata + # more stuff + # only the paths in the FILES.* metadata are monkeyed with + my $done_editing = 0; + my $numFilesMD = 0; + foreach my $line (<$IN>) { + my $out_line = $line; + if (!$done_editing) { + my (@words) = split " ", $line; + if (scalar @words) { + # get rid of any leading blank words + while ((scalar @words) and !defined $words[0]) { + shift @words; + } + + if ($words[1] and $words[1] eq "METADATA") { + if ( $words[0] =~ /^FILES\..+/ ) { + $numFilesMD++; + } + } elsif ($words[0] eq "END") { + # when we get to the end of the second FILES metadata we're done editing + if ($numFilesMD == 2) { + $done_editing = 1; + } + } elsif ($numFilesMD and ($words[1] eq "STR")) { + # we're processing one of the files metadata edit the path + my $key = shift @words; + my $type = shift @words; + my $path = shift @words; + my $extra = join " ", @words; + + $path = edit_path($file_id, $workdir, $path); + + $out_line = "\t" . $key ."\t" . "STR" . "\t" . $path; + $out_line .= "\t" . $extra if $extra; + $out_line .= "\n"; + } + } + } + print $OUT $out_line; + } + + close $IN; + close $OUT or &my_die("failed to close $dest", $file_id, $PS_EXIT_UNKNOWN_ERROR); +} + + +# XXX: this should go into a module +# Replace 'volume portion of path with $workdir/ +# Volume is defined here by +# neb://volume/ +# /xxx/xxxxx/ i.e. /data/ippxxx.y/ +# file://xxx/xxxxx/ i.e. file://data/ippxxx.y/ +# path://somepath/ +sub edit_path +{ + my $file_id = shift; + my $workdir = shift; + my $path = shift; + + my $scheme = file_scheme($path); + my $tail; + if ($scheme) { + # strip off scheme:// + $tail = substr($path, length($scheme) + 3); + } elsif (substr($path, 0, 1) eq '/') { + $tail = substr($path, 1); + $scheme = ""; + } + # remove any leading / that are left + while ((substr($tail, 0, 1) eq '/')) { + $tail = substr($tail, 1); + } + + my @segments; + if (($scheme eq 'neb') or ($scheme eq 'path')) { + my $volume; + ($volume, @segments) = split '/', $tail; + + } elsif (!$scheme or ($scheme eq 'file')) { + + # XXX Here we're assuming the /data/ipp??? structure. This won't be true when data is forwarded + # by remote sites. We need a way to configure this + my $volume; + + # data/ippxxx/dirs + (undef, $volume, @segments) = split '/', $tail; + } else { + &my_die( "unexpected workdir value: $path\n", $file_id, $PS_EXIT_PROG_ERROR); + } + + my $new_path = caturi($workdir, @segments); + + return $new_path; +} +sub findRunType { + my $lines = shift; + my $runType; + my ($firstWord, $multi) = split " ", $lines->[0]; + &my_die( "unexpected first line found in $filename: $lines->[0]\n", + $file_id, $PS_EXIT_UNKNOWN_ERROR) if ($firstWord ne 'dbversion') or ($multi ne 'MULTI'); + + my $dbversionDone = 0; + foreach my $line (@$lines) { + # skip blank lines + next if !$line or $line eq "\n"; + + ($firstWord, $multi) = split " ", $line; + if ($dbversionDone) { + # The first non blank line after the dbversion tells us the run type. + # From this we get the stage + &my_die( "unexpected line found in $filename: $line\n", + $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$firstWord or !$multi or ($multi ne 'MULTI'); + + $runType = $firstWord; + last; + } else { + if ($firstWord and $firstWord eq 'END') { + # we're past the dbversion file now + $dbversionDone = 1; + } + } + } + &my_die( "failed to determine run type from $filename", + $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$runType; + + return $runType; +} + +sub my_die +{ + my $msg = shift; # Exit message + my $file_id = shift; # File identifier + my $fault = shift; # Fault code + + $fault = $PS_EXIT_PROG_ERROR unless defined $fault; + + carp($msg); + if (defined $file_id and not $no_update) { + my $command = "$receivetool -addresult"; + $command .= " -file_id $file_id"; + $command .= " -fault $fault"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + } + exit $fault; +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_fileset.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_fileset.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_fileset.pl (revision 41105) @@ -0,0 +1,146 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use File::Temp qw( tempfile ); +use Carp; + +# Look for programs we need +my $missing_tools; +my $receivetool = can_run('receivetool') or (warn "Can't find receivetool" and $missing_tools = 1); +my $dsproductls = can_run('dsfilesetls') or (warn "Can't find dsfilesetls" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ( $fileset_id, $source, $product, $fileset, $dbname, $verbose, $no_update, $save_temps ); + +GetOptions( + 'fileset_id=s' => \$fileset_id, # Fileset identifier + 'source=s' => \$source, # Source for data + 'product=s' => \$product, # Product for data + 'fileset=s' => \$fileset, # Fileset for data + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'save-temps' => \$save_temps, # keep temp files + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --fileset_id --source --product --fileset", + -exitval => $PS_EXIT_CONFIG_ERROR) unless + defined $fileset_id and + defined $source and + defined $product and + defined $fileset; + +# Get list of files, sanity check and then write it to a temporary file +my $numFiles = 0; +my ($listFile, $listName) = tempfile("/tmp/$product.$fileset.list.XXXX", UNLINK => !$save_temps); +{ + my $uri = "$source/$product/$fileset"; # URI for datastore fileset + $uri .= "/index.txt" unless $uri =~ m|/index.txt$|; + my $command = "dsfilesetls --uri $uri"; # Command to execute + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to get fileset listing from $uri\n", $fileset_id, $error_code) unless $success; + + # Get files + my @lines = split(/\n/, join "", @$stdout_buf); # Lines from output + foreach my $line ( @lines ) { + $line =~ s/\#.*$//; + next unless $line =~ /\S+/; + my @fields = split(/\s+/, $line); # Fields in line + &my_die( "too few columns in fileset list entry: $line\n", $fileset_id, $PS_EXIT_DATA_ERROR) unless scalar @fields >= 6; + + print $listFile "FILE$numFiles\tMETADATA\n"; + + print $listFile "\turi\t\tSTR\t" . $fields[0] . "\n"; + print $listFile "\tfile\t\tSTR\t" . $fields[1] . "\n"; + print $listFile "\tbytes\t\tS64\t" . $fields[2] . "\n"; + print $listFile "\tmd5sum\t\tSTR\t" . $fields[3] . "\n"; + print $listFile "\tfile_type\tSTR\t" . $fields[4] . "\n"; + print $listFile "\tcomponent\tSTR\t" . $fields[5] . "\n"; + + print $listFile "END\n"; + $numFiles++; + } + close $listFile; +} + +# Add files +my $new_state; +if ($numFiles > 0) { + $new_state = "listed"; + my $command = "receivetool -addfile"; # Command to execute + $command .= " -fileset_id $fileset_id"; + $command .= " -file_list $listName"; + $command .= " -dbname $dbname" if defined $dbname; + + unless (defined $no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to add file list for fileset $fileset\n", $fileset_id, $error_code) unless $success; + } +} else { + print STDERR "fileset $fileset has no files\n" if $verbose; + $new_state = "full"; +} + +{ + my $command = "receivetool -updatefileset"; # Command to execute + $command .= " -fileset_id $fileset_id"; + $command .= " -set_state $new_state"; + $command .= " -dbname $dbname" if defined $dbname; + + unless (defined $no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + &my_die( "Unable to set state to $new_state for fileset $fileset\n", $fileset_id, $error_code) unless $success; + } +} + +sub my_die { + my $msg = shift; # Exit message + my $fileset_id = shift; # File identifier + my $fault = shift; # Fault code + + $fault = $PS_EXIT_PROG_ERROR unless defined $fault; + + carp($msg); + if (not $no_update) { + my $command = "$receivetool -updatefileset"; + $command .= " -fileset_id $fileset_id"; + $command .= " -fault $fault"; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + die "Unable to set fault to $fault for fileset $fileset\n" unless $success; + } + exit $fault; +} +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_setstatus.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_setstatus.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_setstatus.pl (revision 41105) @@ -0,0 +1,104 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename dirname ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Look for programs we need +my $missing_tools; +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ($status_fs_name, $status_product, $received_fs_name, $fault, $status_file); +my ($dbname, $save_temps, $verbose, $no_update, $logfile); + +GetOptions( + 'status_fs_name=s' => \$status_fs_name, + 'status_product=s' => \$status_product, + 'received_fs_name=s' => \$received_fs_name, + 'fault=i' => \$fault, + 'status_file=s' => \$status_file, + 'dbname=s' => \$dbname, # Database name + 'save-temps' => \$save_temps, # Save temporary files? + 'verbose' => \$verbose, # Print stuff? + 'logfile=s' => \$logfile, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --status_fs_name --status_product", + -exitval => 3) unless + defined $received_fs_name and + defined $status_product and + defined $fault; +# and ($fault == 0 or defined $status_file); + +# if a name for the status fileset is not provided use the received value +$status_fs_name = $received_fs_name if !defined $status_fs_name; + +$ipprc->redirect_output($logfile) if $logfile; + +{ + # if a status file is provided put it in the fileset otherwise make an empty one + # The status information in the produce list is enough for the server + my $regline = ""; + my $fileargs = " --empty"; + + if ($status_file) { + $regline = "$status_file'|||text|'"; + + $fileargs = " --list - --copy --abspath"; + } + + # XXX need to create a fileset type for this + my $command = "echo $regline | dsreg --add $status_fs_name --product $status_product --type notset"; + $command .= " $fileargs --ps0 $received_fs_name --ps1 $fault"; + $command .= " --dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_CONFIG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $status_fs_name, $error_code); + } +} + +exit 0; + + +sub my_die { + my $msg = shift; + my $fs_name = shift; + my $fault = shift; + + die "$msg fs_name: $fs_name: $fault"; + + exit $fault; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_source.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_source.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/receive_source.pl (revision 41105) @@ -0,0 +1,114 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $receivetool = can_run('receivetool') or (warn "Can't find receivetool" and $missing_tools = 1); +my $dsproductls = can_run('dsproductls') or (warn "Can't find dsproductls" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Parse the command-line arguments +my ( $source_id, $source, $product, $last_fileset, $dbname, $verbose, $no_update ); + +GetOptions( + 'source_id=s' => \$source_id, # Source identifier + 'source=s' => \$source, # Source for data + 'product=s' => \$product, # Product for data + 'last_fileset=s' => \$last_fileset, # Last fileset seen + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --source_id --source --product", + -exitval => $PS_EXIT_CONFIG_ERROR) unless + defined $source_id and + defined $source and + defined $product; + +# Get list of filesets +my $uri = "$source/$product"; # URI for datastore product +$uri .= "/index.txt" unless $uri =~ m|/index.txt$|; +my $command = "dsproductls --uri $uri"; # Command to execute +$command .= " --last_fileset $last_fileset" if defined $last_fileset; + +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); +die "Unable to get source listing from $source for $product\n" unless $success; + +# Parse list of filesets +my @filesets = (); # Filesets to add +my @lines = split(/\n/, join "", @$stdout_buf); # Lines from output +my $numFilesets = 0; +foreach my $line ( @lines ) { + $line =~ s/\#.*//g; + next unless $line =~ /\S+/; + $line =~ s/^\s+//; + my @fields = split(/\s+/, $line); # Fields in line + my $fileset = $fields[1]; + push @filesets, $fileset if defined $fileset and $fileset =~ /\S+/; + + # TODO don't overload recevietool. Tune this limit + $numFilesets++; + last if $numFilesets >= 100; +} + +if (scalar @filesets > 0) { + # Add filesets + { + my $command = "receivetool -addfileset"; # Command to execute + $command .= " -src_id $source_id"; + $command .= " -fileset " . join(' -fileset ', @filesets); + $command .= " -dbname $dbname" if defined $dbname; + + unless (defined $no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + die "Unable to add filesets from $source for $product\n" unless $success; + } + } + + # Update the last fileset seen + { + my $command = "receivetool -updatelast"; # Command to execute + $command .= " -src_id $source_id"; + my $last = pop @filesets; # Last fileset + $command .= " -fileset $last"; + $command .= " -dbname $dbname" if defined $dbname; + + unless (defined $no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + die "Unable to update last fileset to $last\n" unless $success; + } + } +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/regenerate_background.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/regenerate_background.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/regenerate_background.pl (revision 41105) @@ -0,0 +1,358 @@ +#! /usr/bin/env perl + +# Script to call the appropriate commands to regenerate the background models +# for stages subsequent to the chip stage. + +use warnings; +use strict; +use Carp; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use File::Temp qw( tempfile ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw (GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + + + +my $ppConfigDump = can_run('ppConfigDump'); +my $pswarp = can_run('pswarp'); + +# Parse command line options. +my ($stage, $camera, $stage_id, $skycell_id, $dbname, $verbose, $logfile, $save_temps); +GetOptions('stage=s' => \$stage, # which analysis stage to generate bkg model + 'camera|i=s' => \$camera, # user-supplied camera name + 'stage_id=s' => \$stage_id, # id for this stage + 'skycell_id=s' => \$skycell_id, # skycell_id + 'verbose' => \$verbose, # verbose commands + 'logfile=s' => \$logfile, # destination for stdout and stderr + 'save_temps' => \$save_temps, # save temporary files. + 'dbname=s' => \$dbname # database name + ) or pod2usage ( 2 ); + +pod2usage( -msg => "Usage: $0 --camera (name) --stage (stage) --stage_id (stage_id) [--dbname (dbname)]", + -exitval => 2 ) if scalar @ARGV; + +pod2usage( -msg => "Required options: --camera (name) --stage (stage) --stage_id (stage_id)", + -exitval => 3 ) unless + defined $camera and + defined $stage and + defined $stage_id; + +pod2usage( -msg => "Required options: --camera (name) --stage (stage) --stage_id (stage_id) --skycell_id (skycell_id)", + -exitval => 3) if (($stage eq 'warp')&&(!defined($skycell_id))); + + +my $ipprc = PS::IPP::Config->new ( $camera ) or + &my_die("Unable to set up", $stage, $stage_id, $PS_EXIT_CONFIG_ERROR); # used for path/neb info + +# We can only regenerate a background for certain stages. +unless (($stage eq "warp") || ($stage eq "stack") || ($stage eq "warpstack")) { + &my_die("Invalid stage to regenerate", $stage, $stage_id, $PS_EXIT_CONFIG_ERROR); +} + +$ipprc->redirect_output($logfile) or + &my_die("Unable to redirect output to logfile", $stage, $stage_id, $PS_EXIT_UNKNOWN_ERROR) if $logfile; + +my $mdcParser = PS::IPP::Metadata::Config->new; # parser for metadata config files + + +## warp stage +if ($stage eq 'warp') { + my $warp_id = $stage_id; # Because I think I used the wrong id in places. + &my_die("--stage_id required for stage warp", $stage, $stage_id, $PS_EXIT_CONFIG_ERROR) if !$stage_id; + &my_die("--skycell_id required for stage warp", $stage, $stage_id, $PS_EXIT_CONFIG_ERROR) if !$skycell_id; + + # Configuration stuff + my $warptool = can_run('warptool') or + &my_die("Can't find warptool",$stage,$stage_id, $PS_EXIT_UNKNOWN_ERROR); + + my $astromSource; # The astrometry source + { + my $command = "$ppConfigDump -camera $camera -recipe PSWARP BACKGROUND -dump-recipe PSWARP -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", + $stage, $stage_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", + $stage, $stage_id, $PS_EXIT_PROG_ERROR); + $astromSource = metadataLookupStr($metadata, 'ASTROM.SOURCE'); + } + + + my $imfiles; # Array of component files + my $command = "$warptool -warped -warp_id $stage_id -skycell_id $skycell_id"; + $command .= " -dbname $dbname " if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderrr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", $stage, $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + # No results + } + + my $in_md = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $stage, $stage_id, $PS_EXIT_PROG_ERROR); + $imfiles = parse_md_list($in_md) or + &my_die("Unable to parse metadata", $stage, $stage_id, $PS_EXIT_PROG_ERROR); + + foreach my $imfile (@$imfiles) { + my $skycell_id = $imfile->{skycell_id}; + my $path_base = $imfile->{path_base}; + my $tess_id = $imfile->{tess_id}; + + # Parse the results to determine if there are any problems that prevent this from + # being processed. I think I might need to think about this a bit more. + my $status = 1; + $status = 0 unless defined $path_base and $path_base ne "NULL"; + my $poor_quality = $imfile->{quality} > 0; + +# my $bkg_file = $ipprc->filename("PSWARP.OUTPUT.BKGMODEL",$path_base,$skycell_id); +# my $bkg_exists = $ipprc->file_exists($bkg_file); + my $bkg_exists = $imfile->{background_model}; + if ($bkg_exists) { $status = 0; } # We do not need to remake this. + + # Construct temp files + my ($bkgList_file,$bkgList_name) = tempfile("/tmp/bkgreg.warp.bkg.${warp_id}.${skycell_id}.XXXX", + UNLINK => !$save_temps); + my ($astromList_file,$astromList_name) = tempfile("/tmp/bkgreg.warp.astrom.${warp_id}.${skycell_id}.XXXX", + UNLINK => !$save_temps); + my $chipFiles; + { + my $inputs_command = "$warptool -scmap -warp_id $warp_id "; + $inputs_command .= " -skycell_id $skycell_id "; + $inputs_command .= " -dbname $dbname " if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run (command => $inputs_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool -scmap: $error_code", + $skycell_id,$warp_id,$PS_EXIT_SYS_ERROR); + } + my $md = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse warptool -scmap: $error_code", + $skycell_id,$warp_id,$PS_EXIT_SYS_ERROR); + $chipFiles = parse_md_list($md) or + &my_die("Unable to parse warptool -scmap: $error_code", + $skycell_id,$warp_id,$PS_EXIT_SYS_ERROR); + } + my $wrote_astrom = 0; + foreach my $chipFile (@$chipFiles) { + my $bkgModel = $ipprc->filename("PSPHOT.BACKMDL", + $chipFile->{chip_path_base}, + $chipFile->{class_id}); + my $astrom = $ipprc->filename($astromSource,$chipFile->{cam_path_base}); + print $bkgList_file "$bkgModel\n"; + if (!$wrote_astrom) { + print $astromList_file "$astrom\n"; + $wrote_astrom = 1; + } + } + close ($bkgList_file); + close ($astromList_file); + + # Construct skyfile if needed + my $skyCell_name = $ipprc->filename("SKYCELL.TEMPLATE",$path_base,$skycell_id); + my $skyCell_exists = $ipprc->file_exists($skyCell_name); + if (!$skyCell_exists) { # Generate it + my $skyFile = prepare_output("SKYCELL.TEMPLATE", $path_base, $skycell_id, 1); + $ipprc->skycell_file( $tess_id, $skycell_id, $skyFile, $verbose ) or + &my_die("Unable to generate template skycell",$skycell_id,$warp_id,$PS_EXIT_SYS_ERROR); + } + my $bkgOut_log = prepare_output("LOG.EXP",$path_base . ".BKG_REG",$skycell_id,1); + + # Construct pswarp command + my $pswarp_command = "$pswarp "; + $pswarp_command .= " -list $bkgList_name -astromlist $astromList_name -bkglist $bkgList_name "; + $pswarp_command .= " ${path_base} "; + $pswarp_command .= " $skyCell_name "; + $pswarp_command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF "; + $pswarp_command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF "; + $pswarp_command .= " -F SOURCE.PLOT.MOMENTS SOURCE.PLOT.SKY.MOMENTS "; + $pswarp_command .= " -F SOURCE.PLOT.PSFMODEL SOURCE.PLOT.SKY.PSFMODEL "; + $pswarp_command .= " -F SOURCE.PLOT.APRESID SOURCE.PLOT.SKY.APRESID "; + $pswarp_command .= " -recipe PSWARP WARP -Db PSF FALSE -Db BACKGROUND.MODEL TRUE "; + $pswarp_command .= " -Db SOURCES FALSE "; + $pswarp_command .= " -log $bkgOut_log -threads 1 "; + $pswarp_command .= " -dbname $dbname " if defined $dbname; + + # Execute + my ( $success, $error_code, $full_buf, $stdout_buf, $stderrr_buf ) = + run(command => $pswarp_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform pswarp: $error_code", $stage, $stage_id, $error_code); + } + + my $update_command = "$warptool "; + $update_command .= " -updateskyfile -warp_id $warp_id -skycell_id $skycell_id "; + $update_command .= " -set_background_model 1 "; + $update_command .= " -dbname $dbname " if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderrr_buf ) = + run(command => $update_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool: $error_code", $stage, $stage_id, $error_code); + } + + + } +} +## stack stage +elsif ($stage eq 'stack') { + &my_die("--stage_id required for stage stack", $stage, $stage_id, $PS_EXIT_CONFIG_ERROR) if !$stage_id; + my $stack_id = $stage_id; # Same as above. Alias this so I don't make mistakes. + + # Configuration stuff + my $stacktool = can_run('stacktool') or + &my_die("Can't find stacktool",$stage,$stage_id,$PS_EXIT_UNKNOWN_ERROR); + my $ppStackMedian = can_run('ppStackMedian') or + &my_die("Can't find ppStackMedian",$stage,$stage_id,$PS_EXIT_UNKNOWN_ERROR); + + # Get the information about this run + my $st_command = "$stacktool -sumskyfile -stack_id $stack_id"; + $st_command .= " -dbname $dbname " if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $st_command, verbose => $verbose); + unless($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -sumskyfile",$stage,$stage_id,$error_code); + } + if (@$stdout_buf == 0) { + # Nothing to do; + } + my $in_md = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $stage, $stage_id, $PS_EXIT_PROG_ERROR); + my $stacks = parse_md_list($in_md) or + &my_die("Unable to parse metadata", $stage, $stage_id, $PS_EXIT_PROG_ERROR); + my $stack = shift(@$stacks); + my $path_base = $stack->{path_base}; + + # Get inputs + my $imfiles; # Array of component files + my $command = "$stacktool -inputskyfile -stack_id $stack_id"; + $command .= " -dbname $dbname " if defined $dbname; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -inputskyfile",$stage,$stage_id,$error_code); + } + if (@$stdout_buf == 0) { + # Nothing to do; + } + $in_md = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $stage, $stage_id, $PS_EXIT_PROG_ERROR); + $imfiles = parse_md_list($in_md) or + &my_die("Unable to parse metadata", $stage, $stage_id, $PS_EXIT_PROG_ERROR); + + my $num = 0; + my $expTime; + my ($inputMDC_file, $inputMDC_name) = tempfile("/tmp/bkgreg.stack.mdc.${stage_id}.XXXX", + UNLINK => !$save_temps); + foreach my $imfile (@$imfiles) { + if ($imfile->{ignored}) {next; } + unless ($imfile->{background_model}) { + &my_die("Not all inputs have valid background models", + $stage,$stage_id,$PS_EXIT_PROG_ERROR); + } + print $inputMDC_file "INPUT${num}\tMETADATA\n"; + + print $inputMDC_file "\tIMAGE\tSTR\t" . $ipprc->filename( "PSWARP.OUTPUT.BKGMODEL", + $imfile->{path_base} ) . "\n"; + print $inputMDC_file "\tSOURCES\tSTR\t" . $ipprc->filename( "PSWARP.OUTPUT.SOURCES", + $imfile->{path_base} ) . "\n"; + print $inputMDC_file "END\n\n"; + $num++; + + $expTime = $imfile->{exp_time}; # I need something here. + } + close($inputMDC_file); + + my $bkgOut_log = prepare_output("LOG.EXP",$path_base . ".BKG_REG",1); + + my $ppStack_command = "$ppStackMedian -input $inputMDC_name ${path_base}.mdl "; + $ppStack_command .= " -recipe PPSTACK STACK -recipe PPSUB STACK -recipe PSPHOT STACK "; + $ppStack_command .= " -recipe PPSTATS STACKSTATS -stack-type DEEP_STACK "; +# $ppStack_command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE "; +# $ppStack_command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF "; +# $ppStack_command .= " -F SOURCE.PLOT.MOMENTS SOURCE.PLOT.SKY.MOMENTS "; +# $ppStack_command .= " -F SOURCE.PLOT.PSFMODEL SOURCE.PLOT.SKY.PSFMODEL "; +# $ppStack_command .= " -F SOURCE.PLOT.APRESID SOURCE.PLOT.SKY.APRESID "; + $ppStack_command .= " -Db PHOTOMETRY F -Db VARIANCE F -Db CONVOLVE F "; + $ppStack_command .= " -Df DEFAULT.EXPTIME $expTime "; + $ppStack_command .= " -threads 1 -log $bkgOut_log "; + $ppStack_command .= " -dbname $dbname " if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $ppStack_command, verbose => $verbose); + unless($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStackMedian",$stage,$stage_id,$error_code); + } + + my $update_command = "$stacktool "; + $update_command .= " -updatesumskyfile -stack_id $stack_id "; + $update_command .= " -set_background_model 1 -fault 0 "; + $update_command .= " -dbname $dbname " if defined $dbname; + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $update_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool: $error_code", $stage, $stage_id, $error_code); + } + + + +} +## do both warp and stack +elsif ($stage eq 'warpstack') { + +} + +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $skycell_id = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, $skycell_id, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $skycell_id, $stage_id, $error); + return $output; +} + + +sub my_die { + my $msg = shift; # Warning message on die + my $stage = shift; # stage name + my $stage_id = shift; # identifier + my $exit_code = shift; # exit code + + carp($msg); + exit $exit_code; +} + + + + + + + + + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/register_exp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/register_exp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/register_exp.pl (revision 41105) @@ -0,0 +1,375 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Cache::File; +use Storable qw( freeze thaw ); +use File::Basename qw( basename ); +use File::Temp qw( tempfile ); # tools to construct temp files +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for commands we need +my $missing_tools; +my $regtool = can_run('regtool') or (warn "can't find regtool" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($cache, $exp_id, $exp_tag, $label, $dvodb, $end_stage, $tess_id, $dbname, $verbose, $no_update, $no_op, $save_temps, $logfile); +GetOptions( + 'caches' => \$cache, + 'exp_id|e=s' => \$exp_id, + 'exp_tag|t=s' => \$exp_tag, + 'dbname|d=s' => \$dbname, # Database name + 'label=s' => \$label, + 'dvodb=s' => \$dvodb, + 'end_stage=s' => \$end_stage, + 'tess_id=s' => \$tess_id, + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'save-temps' => \$save_temps, # Save temporary files? + 'logfile=s' => \$logfile, +) or pod2usage( 2 ); + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $exp_id, $PS_EXIT_CONFIG_ERROR ); +$ipprc->redirect_to_logfile($logfile) or my_die( "Unable to redirect output", $exp_id, $PS_EXIT_SYS_ERROR ) if $logfile; + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --exp_id --exp_tag", + -exitval => 3) unless + defined $exp_id and + defined $exp_tag; + +# add -detrend UNLESS type is one of SCIENCE listed below (eg, OBJECT) +my @SCIENCE = ( "object", "science", "light" ); # Observation types to NOT mark as detrend +my $DETREND_FLAG = "-end_stage reg"; # Flag to use to mark detrend exposure + +# setup cache interface +my $c = Cache::File->new( + cache_root => File::Spec->catdir($ENV{'HOME'}, '.pxtools', basename($0)), + default_expires => '7200 sec', +); + +my $cmdflags; + +# Get the list of imfiles & their stats +{ + my $command = "$regtool -processedimfile -exp_id $exp_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform regtool -processedimfile on exposure id $exp_id: $error_code"); + exit ($error_code); + } + + # since I can't figure out how to do input and output within PERL, I'm writing to a temp file + my ($statFile, $statName) = tempfile( "/tmp/$exp_id.register.XXXX", UNLINK => !$save_temps ); + print "saving stats to $statName\n"; + foreach my $line (@$stdout_buf) { + print $statFile $line; + } + close $statFile; + + # parse the stats in the metadata file + $command = "$ppStatsFromMetadata $statName - REGISTER_EXP"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform ppStatsFromMetadata: $error_code\n"); + exit($error_code); + } + + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; +} + +# we require at a minimum: -telescope, -inst, -filelevel, -class_id, -exp_name, -exp_type +if (uc(&value_for_flag ($cmdflags, "-telescope")) eq "NULL") { &my_die ("telescope not found", $exp_id, $PS_EXIT_CONFIG_ERROR); } +if (uc(&value_for_flag ($cmdflags, "-inst")) eq "NULL") { &my_die ("inst not found", $exp_id, $PS_EXIT_CONFIG_ERROR); } +if (uc(&value_for_flag ($cmdflags, "-filelevel")) eq "NULL") { &my_die ("filelevel not found", $exp_id, $PS_EXIT_CONFIG_ERROR); } +if (uc(&value_for_flag ($cmdflags, "-exp_name")) eq "NULL") { &my_die ("exp_name not found", $exp_id, $PS_EXIT_CONFIG_ERROR); } + +my $exp_type = &value_for_flag ($cmdflags, "-exp_type"); +if (uc($exp_type) eq "NULL") { &my_die ("exp_type not found", $exp_id, $PS_EXIT_CONFIG_ERROR); } + +my ($data_group,$dist_group,$chip_workdir,$reduction); +($label,$data_group,$dist_group,$end_stage, + $tess_id,$chip_workdir,$reduction) = advance_decisions(&value_for_flag($cmdflags,"-exp_name"), + &value_for_flag($cmdflags,"-dateobs"), + &value_for_flag($cmdflags,"-exp_type"), + &value_for_flag($cmdflags,"-obs_mode"), + &value_for_flag($cmdflags,"-object"), + &value_for_flag($cmdflags,"-comment"), + $dbname); +my $command = "$regtool -addprocessedexp"; +$command .= " -exp_id $exp_id"; +$command .= " -exp_tag $exp_tag"; +$command .= " -hostname $host" if defined $host; +$command .= " -dbname $dbname" if defined $dbname; +$command .= " -label $label" if defined $label; +$command .= " -dvodb $dvodb" if defined $dvodb; +$command .= " -end_stage $end_stage" if defined $end_stage; +$command .= " -tess_id $tess_id" if defined $tess_id; +$command .= " -data_group $data_group" if defined $data_group; +$command .= " -dist_group $dist_group" if defined $dist_group; +$command .= " -chip_workdir $chip_workdir" if defined $chip_workdir; +$command .= " -reduction $reduction" if defined $reduction; +$command .= " -state full"; +$command .= " $cmdflags"; + +# Add the detrend flag, if needed +{ + my $object = 0; # Is it an object exposure? + foreach my $scienceType (@SCIENCE) { + if (lc($exp_type) =~ /$scienceType/) { + $object = 1; + last; + } + } + $command .= " $DETREND_FLAG" unless $object; +} + +# Output results to the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + cache_run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to run regtool -addprocessedexp for $exp_id: $error_code"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +### Pau. +sub advance_decisions { + my $exp_name = shift; + my $dateobs = shift; + my $exptype = shift; + my $obsmode = shift; + my $object = shift; + my $comment = shift; + my $dbname = shift; + + # The strings come pre-quoted. + $exp_name =~ s/\'//g; + $dateobs =~ s/\'//g; + $exptype =~ s/\'//g; + $obsmode =~ s/\'//g; + $object =~ s/\'//g; + $comment =~ s/\'//g; + + print "Inside decision engine\n"; + my ($label,$data_group,$dist_group,$end_stage,$tess_id,$chip_workdir,$reduction); + my $target; + + if ($exp_name =~ /^c/) { + print "Skipping because this is a camera commanded exposure: $exp_name\n"; + return(undef,undef,undef,"reg",undef,undef,undef); + } + + if ($exptype ne 'OBJECT') { + print "Skipping because exptype doesn't claim to be OBJECT: $exptype\n"; + return(undef,undef,undef,"reg",undef,undef,undef); + } + if ($obsmode eq 'ENGINEERING') { + print "Skipping because we don't queue engineering data to chip\n"; + return(undef,undef,undef,"reg",undef,undef,undef); + } + # Grab the configuration data. + my %nightlyscience_config = (); + my $conf_cmd = "$ppConfigDump -dump-recipe NIGHTLY_SCIENCE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $date, $PS_EXIT_SYS_ERROR); + } + print "data loaded\n"; + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'TARGETS') { + my @target_data = @{ ${ $entry }{value} }; + my $this_target = ''; + foreach my $tentry (@target_data) { + if (${ $tentry }{name} eq 'NAME') { + $this_target = ${ $tentry }{value}; + $nightlyscience_config{$this_target}{DISTRIBUTION} = $this_target; + } + elsif (${ $tentry }{name} eq 'DISTRIBUTION') { + $nightlyscience_config{$this_target}{DISTRIBUTION} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'TESS') { + $nightlyscience_config{$this_target}{TESS_ID} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'OBSMODE') { + $nightlyscience_config{$this_target}{OBSMODE} = ${ $tentry }{value}; + $nightlyscience_config{$this_target}{OBSMODE} =~ s/%/\.\*/g; + } + elsif (${ $tentry }{name} eq 'OBJECT') { + $nightlyscience_config{$this_target}{OBJECT} = ${ $tentry }{value}; + $nightlyscience_config{$this_target}{OBJECT} =~ s/%/\.\*/g; + } + elsif (${ $tentry }{name} eq 'COMMENT') { + $nightlyscience_config{$this_target}{COMMENT} = ${ $tentry }{value}; + $nightlyscience_config{$this_target}{COMMENT} =~ s/%/\.\*/g; + } + elsif (${ $tentry }{name} eq 'STACKABLE') { + $nightlyscience_config{$this_target}{STACKABLE} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'DIFFABLE') { + $nightlyscience_config{$this_target}{DIFFABLE} = ${ $tentry }{value}; + } + elsif (${ $tentry }{name} eq 'REDUCTION') { + $nightlyscience_config{$this_target}{REDUCTION} = ${ $tentry }{value}; + } + } + } + } + print "data parsed\n"; + my $found_target; + foreach $target (keys %nightlyscience_config) { +# print "TEST: $target ($obsmode $object $comment) ($nightlyscience_config{$target}{OBSMODE} $nightlyscience_config{$target}{OBJECT} $nightlyscience_config{$target}{COMMENT}\t"; + my $match = 0; + my $possible = 0; + if (exists($nightlyscience_config{$target}{OBSMODE})) { + $possible++; + if ($obsmode =~ /^$nightlyscience_config{$target}{OBSMODE}$/) { + $match++; + } + } + if (exists($nightlyscience_config{$target}{OBJECT})) { + $possible++; + if ($object =~ /^$nightlyscience_config{$target}{OBJECT}$/) { + $match++; + } + } + if (exists($nightlyscience_config{$target}{COMMENT})) { + $possible++; + if ($comment =~ /^$nightlyscience_config{$target}{COMMENT}$/) { + $match++; + } + } + print "$possible $match\n"; + if (($possible > 0)&&($match == $possible)) { + $found_target = $target; + last; + } + } + unless ($found_target) { + print "No acceptible target found.\n"; + return(undef,undef,undef,"reg",undef,undef,undef); + } + print "Found this target: $found_target\n"; + print "$dateobs\n"; + $target = $found_target; + + my $date = $dateobs; + $date =~ s/T.*//; + my $workdir_date = $date; + $date =~ s/-//g; + $workdir_date =~ s%-%/%g; + print "$dateobs $date $workdir_date\n"; + $label = "${target}.nightlyscience"; + $data_group = "${target}.${date}"; + $dist_group = $nightlyscience_config{$target}{DISTRIBUTION}; + $end_stage = 'warp'; + $tess_id = $nightlyscience_config{$target}{TESS_ID}; + $chip_workdir = "neb://\@HOST\@.0/${dbname}/${target}.nt/${workdir_date}/"; + if (exists($nightlyscience_config{$target}{REDUCTION})) { + $reduction = $nightlyscience_config{$target}{REDUCTION}; + } + else { + undef($reduction); + } + + + return ($label,$data_group,$dist_group,$end_stage,$tess_id,$chip_workdir,$reduction); +} + + + + +sub cache_run +{ + my %p = @_; + + my $cmd_output = $c->get($p{command}) if $cache; + if (defined $cmd_output) { + return @{thaw $cmd_output}; + } else { + my @output = run(%p); + $c->set($p{command}, freeze \@output) if $cache; + return @output; + } +} + +sub value_for_flag +{ + my $cmdflags = shift; + my $flag = shift; + + my $value = 0.0; + if ($cmdflags =~ m|$flag|) { + ($value) = $cmdflags =~ m|$flag\s+(\S+)|; + } + $value; +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $exp_id = shift; + my $exit_code = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $exp_id and not $no_update) { + my $command = "$regtool -addprocessedexp -exp_id $exp_id -fault $exit_code"; + $command .= " -exp_tag $exp_tag"; + $command .= " -exp_name UNKNOWN"; + $command .= " -inst UNKNOWN"; + $command .= " -telescope UNKNOWN"; + $command .= " -telescope UNKNOWN"; + $command .= " -filelevel UNKNOWN"; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + system($command); + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/register_imfile.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/register_imfile.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/register_imfile.pl (revision 41105) @@ -0,0 +1,552 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +my $cmd_line = join ' ', @ARGV; +print "Starting script $0 $cmd_line on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Cache::File; +use Storable qw(freeze thaw); +use File::Basename qw( basename); +use IPC::Run; +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Config 1.01 qw( :standard ); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Metadata::Config; +use Math::Trig; + +use File::Spec; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $regtool = can_run( 'regtool' ) or (warn "Can't find regtool" and $missing_tools = 1); +my $ppStats = can_run( 'ppStats' ) or (warn "Can't find ppStats" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run( 'ppStatsFromMetadata' ) or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $ppConfigDump = can_run( 'ppConfigDump' ) or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ippApplyBurntoolSingle = can_run( 'ipp_apply_burntool_single.pl' ) or (warn "Can't find ipp_apply_burntool_single" and $missing_tools = 1); + +my ($cache, $exp_id, $tmp_class_id, $tmp_exp_name, $uri, $bytes, $md5sum, $dbname, $verbose, $no_update, $no_op, $logfile); +my ($sunrise, $sunset, $summit_dateobs); +GetOptions( + 'caches' => \$cache, + 'exp_id|e=s' => \$exp_id, + 'tmp_class_id|i=s' => \$tmp_class_id, + 'tmp_exp_name|n=s' => \$tmp_exp_name, + 'uri|u=s' => \$uri, + 'bytes=s' => \$bytes, + 'md5sum=s' => \$md5sum, + 'sunrise=s' => \$sunrise, + 'sunset=s' => \$sunset, + 'summit_dateobs=s' => \$summit_dateobs, + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, + 'no-op' => \$no_op, + 'logfile=s' => \$logfile, +) or pod2usage( 2 ); + +my $ipprc = PS::IPP::Config->new() or my_die_for_add( "Unable to set up", $exp_id, $tmp_exp_name, $tmp_class_id, $uri, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$ipprc->redirect_to_logfile($logfile) or my_die_for_add( "Unable to redirect output", $exp_id, $tmp_exp_name, $tmp_class_id, $uri, $PS_EXIT_SYS_ERROR ) if $logfile; + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --exp_id --tmp_class_id --tmp_exp_name --uri", + -exitval => 3) unless + defined $exp_id and + defined $tmp_class_id and + defined $tmp_exp_name and + defined $uri; + +unless (defined($sunset)) { + $sunset = '03:30:00'; +} +unless (defined($sunrise)) { + $sunrise = '17:30:00'; +} + +my $RECIPE = "REGISTER"; # Recipe to use for ppStats + +if ($missing_tools) { + warn ("Can't find required tools"); + exit($PS_EXIT_CONFIG_ERROR); +} + +# setup cache interface +# XXX why is this being cached? +my $c = Cache::File->new( + cache_root => File::Spec->catdir($ENV{'HOME'}, '.pxtools', basename($0)), + default_expires => '7200 sec', +); + +my $now_time = localtime(); +printf STDERR "\nstarting ppStats: %s\n", $now_time if $verbose; + +my $cmdflags; +my $burntoolStateTarget; +my $burntoolStateCurrent; +# Run ppStats on the input file +{ + my $command1 = "$ppStats $uri -recipe PPSTATS $RECIPE -level"; + my $command2 = "$ppStatsFromMetadata - - REGISTER_IMFILE"; + + # Since there are no spaces in the arguments, we can get away with this: + my @command1 = split(/ /, $command1); + my @command2 = split(/ /, $command2); + + # Run ppStats + my ($in1, $out1, $err1); # Buffers for ppStats + my $h1 = IPC::Run::harness \@command1, \$in1, \$out1, \$err1; + print "[Running $command1]\n"; + my $result1 = IPC::Run::run $h1; + print "STDOUT:\n$out1"; + print "STDERR:\n$err1"; + &my_die_for_add("Unable to perform ppStats on exposure id $exp_id: " . $h1->result(), $exp_id, $tmp_exp_name, $tmp_class_id, $uri, ($h1->result() or $PS_EXIT_PROG_ERROR) ) unless $result1; + + print "[Running " . join(' ', @command2) . "]\n"; + my ($out2, $err2); # Buffers for ppStatsFromMetadata + my $h2 = IPC::Run::harness \@command2, \$out1, \$out2, \$err2; + print "[Running $command2]\n"; + my $result2 = IPC::Run::run $h2; + print "STDOUT:\n$out2"; + print "STDERR:\n$err2"; + &my_die_for_add("Unable to perform ppStatsFromMetadata on exposure id $exp_id: " . $h2->result(), $exp_id, $tmp_exp_name, $tmp_class_id, $uri, ($h2->result() or $PS_EXIT_PROG_ERROR) ) unless $result2; + chomp $out2; + $cmdflags = $out2; + + # Manually parse the burntool_state entry. + $burntoolStateCurrent = 0; + my $isGPC1 = 0; + $burntoolStateTarget = 0; + foreach my $line (split /\n/, $out1) { + if ($line =~ /FPA.BURNTOOL.APPLIED/) { + $line =~ s/^\s+//; + $burntoolStateCurrent = (split /\s+/, $line)[2]; + } + if ($line =~ /FPA.CAMERA/) { + $line =~ s/^\s+//; + if ((split /\s+/, $line)[2] eq 'GPC1') { + $isGPC1 = 1; + } + } + } + if ($isGPC1 != 1) { + $burntoolStateCurrent = 0; # If it's not GPC1, you shouldn't have run burntool. + } + elsif (($isGPC1 == 1) && ($burntoolStateCurrent == 1)) { +# print STDERR "In the good region: >>$burntoolStateCurrent<<\n"; + my $ppConfigDump_cmd = "$ppConfigDump -camera GPC1 -get-key BURNTOOL.STATE.GOOD"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + IPC::Cmd::run(command => $ppConfigDump_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform ppConfigDump"); + exit($error_code); + } + + # This is ugly, but doing a full parse for one entry is a bit wasteful. + foreach my $line (split /\n/, (join "", @$stdout_buf)) { + if ($line =~ /BURNTOOL.STATE.GOOD/) { + $line =~ s/^\s+//; + $burntoolStateTarget = (split /\s+/, $line)[2]; + last; + } + } + # XXX why was this being equated?? + # $burntoolState = $burntoolStateGood; # Positive because this has the header table. + + } + $cmdflags .= " -burntool_state $burntoolStateTarget "; +} + +$now_time = localtime(); +printf STDERR "\ndone with ppStats: %s\n", $now_time if $verbose; +printf STDERR "\nburntool state current: %d target: %d\n", $burntoolStateCurrent, $burntoolStateTarget; + +# we require at a minimum: -telescope, -inst, -filelevel, -class_id, -exp_type +if (uc(&value_for_flag ($cmdflags, "NULL", "-telescope")) eq "NULL") { &my_die_for_add ("telescope not found", $exp_id, $tmp_exp_name, $tmp_class_id, $uri, $PS_EXIT_CONFIG_ERROR); } +if (uc(&value_for_flag ($cmdflags, "NULL", "-inst")) eq "NULL") { &my_die_for_add ("inst not found", $exp_id, $tmp_exp_name, $tmp_class_id, $uri, $PS_EXIT_CONFIG_ERROR); } +if (uc(&value_for_flag ($cmdflags, "NULL", "-filelevel")) eq "NULL") { &my_die_for_add ("filelevel not found", $exp_id, $tmp_exp_name, $tmp_class_id, $uri, $PS_EXIT_CONFIG_ERROR); } +if (uc(&value_for_flag ($cmdflags, "NULL", "-class_id")) eq "NULL") { &my_die_for_add ("class_id not found", $exp_id, $tmp_exp_name, $tmp_class_id, $uri, $PS_EXIT_CONFIG_ERROR); } +if (uc(&value_for_flag ($cmdflags, "NULL", "-exp_type")) eq "NULL") { &my_die_for_add ("exp_type not found", $exp_id, $tmp_exp_name, $tmp_class_id, $uri, $PS_EXIT_CONFIG_ERROR); } +my $dateobs = &value_for_flag($cmdflags, 0.0, "-dateobs"); +unless($summit_dateobs) { + $summit_dateobs = $dateobs; +} + +my $exp_type = &value_for_flag($cmdflags, "NULL", "-exp_type"); + +my $command = "$regtool -addprocessedimfile"; +$command .= " -exp_id $exp_id"; +$command .= " -exp_name $tmp_exp_name"; # keep the supplied exp_name (could be derived from the file) +$command .= " -tmp_class_id $tmp_class_id"; # the original class_id supplied by the user, replace by ppStats CLASS.ID +$command .= " -uri $uri "; +$command .= " -bytes $bytes" if $bytes; +$command .= " -md5sum $md5sum" if $md5sum and ($md5sum ne 'NULL'); +$command .= " -hostname $host" if defined $host; +$command .= " -dbname $dbname" if defined $dbname; +if (abs($burntoolStateCurrent) == $burntoolStateTarget) { + printf STDERR "This has already been burned.\n"; + $command .= " -data_state full"; +} +elsif (is_daytime($summit_dateobs,$sunrise,$sunset)) { + printf STDERR "This is a daytime exposure.\n"; + $command .= " -data_state full"; +} +elsif (is_ccim($tmp_exp_name,$exp_type)) { + printf STDERR "This is a camera commanded detrend exposure that should not cause a burn.\n"; + $command .= " -data_state full"; +} +else { + printf STDERR "Need to check burntool.\n"; + $command .= " -data_state check_burntool"; +} +$command .= " $cmdflags"; + +print "$command\n"; +# determine solar-system parameters +my $longitude = &value_for_flag($cmdflags, 0.0, "-longitude"); +my $latitude = &value_for_flag($cmdflags, 0.0, "-latitude"); +my $elevation = &value_for_flag($cmdflags, 0.0, "-elevation"); +my $ra = &value_for_flag($cmdflags, 0.0, "-ra"); +my $dec = &value_for_flag($cmdflags, 0.0, "-decl"); + + +# if the needed data is available, pass it to sunmoon: +if ($longitude && $latitude && $ra && $dec && $dateobs) { + + $longitude *= 12.0 / pi; # longitude is reported in West radians; sunmoon wants it in West Hours + $latitude *= 180.0 / pi; # latitude is reported in North radians; sunmoon wants it in North Degrees + $ra *= 180.0 / pi; # ra is reported in radians; sunmoon wants it in degrees + $dec *= 180.0 / pi; # dec is reported in radians; sunmoon wants it in degrees + + my $sunmoon_cmd = "sunmoon -latitude $latitude -longitude $longitude -elevation $elevation $dateobs $ra $dec"; + my $sunmoon_data = `$sunmoon_cmd`; + chomp $sunmoon_data; + + # print STDERR "run: $sunmoon_cmd\n"; + # print STDERR "got: $sunmoon_data\n"; + + if ($?) { + warn ("failure running $sunmoon_cmd, not supplying\n"); + } else { + $command .= " $sunmoon_data"; + } +} + +# This might have a race condition +# $date_end = $dateobs; +# $date_start = $dateobs - 30 minutes ? dateobs_UTC_midnight? +# lock file? +# if exp_type = DARK and date > MIDNIGHT HST { wait } +# system("ipp_apply_burntool.pl --class_id $class_id --dateobs_begin $date_start --dateobs_end $date_end --dbname gpc1 --logfile /data/$host.0/burntool_logs/$class_id.$start_date.log"); + +$now_time = localtime(); +printf STDERR "\nrunning regtool update: %s\n", $now_time if $verbose; + +# Push the results into the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + IPC::Cmd::run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform regtool -addprocessedimfile: $error_code"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +# We now have an imfile in the database, check if we can burntool it. If not, continue on. + +if ((abs($burntoolStateCurrent) != $burntoolStateTarget)&& + (!is_daytime($summit_dateobs,$sunrise,$sunset))&& + (!is_ccim($tmp_exp_name,$exp_type))) { + my $mdcParser = PS::IPP::Metadata::Config->new; + + my $class_id = &value_for_flag($cmdflags, 0.0, "-class_id"); + my $check_date = &value_for_flag($cmdflags, 0.0, "-dateobs"); + $check_date =~ s/T.*$//; + my $exp_name = $tmp_exp_name; + + + my $bt_check_command = "$regtool -checkburntoolimfile "; + $bt_check_command .= " -class_id $class_id "; + $bt_check_command .= " -dateobs_begin ${check_date}T${sunset} "; + $bt_check_command .= " -dateobs_end ${check_date}T${sunrise} "; + $bt_check_command .= " -valid_burntool $burntoolStateTarget "; + $bt_check_command .= " -exp_name $exp_name "; + $bt_check_command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run ( command => $bt_check_command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die_for_update("Unable to perform regtool: $error_code", + $exp_id, $class_id, $PS_EXIT_SYS_ERROR); + } + + my @whole = split /\n/, (join "", @$stdout_buf); + my @single = (); + my $exposures; + while ( scalar @whole > 0 ) { + my $value = shift @whole; + push @single, $value; + if ($value =~ /^\s*END\s*$/) { + push @single, "\n"; + + my $list = parse_md_list( $mdcParser->parse( join( "\n", @single ) ) ); + &my_die_for_update("Unable to parse output from regtool", + $exp_id, $class_id, $PS_EXIT_SYS_ERROR) unless + defined $list; + push @{ $exposures }, @$list; + @single = (); + } + } + + # We only care about the final entry, as that contains the exposure we are. + + my $regtool_update = "$regtool -updateprocessedimfile "; + $regtool_update .= "-dbname $dbname " if defined $dbname; + $regtool_update .= "-exp_id $exp_id -class_id $class_id "; + + my $burntool_data = pop(@{ $exposures }); + if ($burntool_data->{burnable} == 0) { + $regtool_update .= " -burntool_state 0 -set_state pending_burntool "; + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + IPC::Cmd::run(command => $regtool_update, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn ("Unable to perform regtool -updateprocessedimfile: $error_code"); +# exit($error_code); + &my_die_for_update("Unable to perform updateprocessedimfile", + $exp_id, $class_id, $error_code); + + } + } else { + print "skipping command: $command\n"; + } + } + else { + my $apply_command = "$ippApplyBurntoolSingle --dbname $dbname "; + $apply_command .= " --class_id $class_id --exp_id $exp_id "; + $apply_command .= " --this_uri $burntool_data->{uri} "; + $apply_command .= " --camera GPC1 "; # hack, but we're only going to get here if we're GPC1. + $apply_command .= " --previous_uri $burntool_data->{previous_uri} " if defined $burntool_data->{previous_uri}; + $apply_command .= " --imfile_state $burntool_data->{imfile_state} "; + $apply_command .= " --verbose " if $verbose; + + # TEMPORARY + $apply_command .= " --camera GPC1"; + print "$apply_command\n"; + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + IPC::Cmd::run(command => $apply_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die_for_update("Unable to perform ipp_apply_burntool_single.pl: $error_code", + $exp_id, $class_id, $PS_EXIT_SYS_ERROR); + } + } + } + + +} + + + +$now_time = localtime(); +printf STDERR "\ndone with regtool update: %s\n", $now_time if $verbose; + +sub cache_run +{ + my %p = @_; + + my $cmd_output = $c->get($p{command}) if $cache; + if (defined $cmd_output) { + return @{thaw $cmd_output}; + } else { + my @output = IPC::Cmd::run(%p); + $c->set($p{command}, freeze \@output) if $cache; + return @output; + } +} + +sub value_for_flag +{ + my $cmdflags = shift; + my $default = shift; + my $flag = shift; + + my $value = $default; + if ($cmdflags =~ m|$flag|) { + ($value) = $cmdflags =~ m|$flag\s+(\S+)|; + } + $value; +} + +sub is_ccim +{ + my $exp_name = shift; + my $exp_type = shift; + $exp_type =~ s/'//g; + # needs to match regtool.c checks for "is_ccim". + if ($exp_name =~ /c/) { + if (($exp_type eq 'DOMEFLAT')|| + ($exp_type eq 'DARK')|| + ($exp_type eq 'BIAS')) { + return(1); + } + } + if ($exp_name =~ /a$/) { + return(1); + } + return(0); +} + +sub is_daytime +{ + my $dateobs = shift; + my $sunset = shift; + my $sunrise = shift; + + my ($date,$time); + + if ($dateobs =~ /T/) { + ($date,$time) = split /T/, $dateobs; + } + else { + ($date,$time) = split / /, $dateobs; + } + my ($hour,$minute,$second) = split /\:/, $time; # /; + my ($ss_hour,$ss_minute,$ss_second) = split /\:/, $sunset; # /; + my ($sr_hour,$sr_minute,$sr_second) = split /\:/, $sunrise; # /; + if ($second =~ /Z/) { + $second =~ s/Z//; + } +# print "this exposure: $hour $minute $second\n"; +# print "sunset: $ss_hour $ss_minute $ss_second\n"; +# print "sunrise: $sr_hour $sr_minute $sr_second\n"; +# printf "Hss: %d Mss: %d Sss: %d\n",($hour >= $ss_hour),($minute >= $ss_minute),($second >= $ss_second); +# printf "Hsr: %d Msr: %d Ssr: %d\n",($hour <= $sr_hour),($minute <= $sr_minute),($second <= $sr_second); + + if (($hour > $ss_hour)&&($hour <= 24)) { + return(1); # After sunset by more than an hour, before midnight + } + elsif ($hour == $ss_hour) { + if ($minute > $ss_minute) { + return(1); # After sunset by more than a minute + } + elsif ($minute == $ss_minute) { + if ($second >= $ss_second) { + return(1); # After sunset by more than a second + } + else { + return(0); + } + } + else { + return(0); + } + } + elsif (($hour < $sr_hour)&&($hour >= 0)) { + return(1); # Before sunrise by more than an hour, but after midnight + } + elsif ($hour == $sr_hour) { + if ($minute < $sr_minute) { + return(1); # Before sunrise by more than a minute + } + elsif ($minute == $sr_minute) { + if ($second <= $sr_second) { + return(1); # Before sunrise by more than a second + } + else { + return(0); + } + } + else { + return(0); + } + } + else { + return(0); # We should never get here. + } +} + +sub my_die_for_add +{ + my $msg = shift; # Warning message on die + my $exp_id = shift; + my $exp_name = shift; + my $tmp_class_id = shift; + my $uri = shift; + my $exit_code = shift; + + # for failed imfiles, we insert UNKNOWN for inst, telescope, class_id + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $exp_id && defined $tmp_class_id and not $no_update) { + my $command = "$regtool -addprocessedimfile"; + $command .= " -exp_id $exp_id"; + $command .= " -exp_name $exp_name"; + $command .= " -tmp_class_id $tmp_class_id"; + $command .= " -uri $uri "; + $command .= " -telescope UNKNOWN"; + $command .= " -inst UNKNOWN"; + $command .= " -class_id $tmp_class_id"; + $command .= " -fault $exit_code"; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + print "Running: $command\n"; + system($command); + } + exit $exit_code; +} +sub my_die_for_update +{ + my $msg = shift; # Warning message on die + my $exp_id = shift; + my $class_id = shift; + my $exit_code = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $exp_id && defined $class_id and not $no_update) { + sleep(5); + my $command = "$regtool -updateprocessedimfile"; + $command .= " -exp_id $exp_id"; + $command .= " -class_id $class_id"; + $command .= " -fault $exit_code"; + $command .= " -set_state pending_burntool "; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + print "Running: $command\n"; + system($command); + } + exit $exit_code; +} + +# Pau. + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/relgroup_exp_list.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/relgroup_exp_list.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/relgroup_exp_list.pl (revision 41105) @@ -0,0 +1,269 @@ +#!/usr/bin/env perl + +# make a exposure list the exposures in a relGroup (a given night or LAP run) + +use strict; +use warnings; + +use Carp; +use File::Basename; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use DBI; +use Time::Local; +use PS::IPP::Config 1.01 qw( :standard ); +use IPC::Cmd 0.36 qw( can_run run ); + + +my ($group_id, $group_type, $lap_id, $group_name, $release_name, $rebuild, $dbname, $no_update, $verbose); + +GetOptions( + 'group_id=s' => \$group_id, + 'group_type=s' => \$group_type, + 'lap_id=s' => \$lap_id, + 'group_name=s' => \$group_name, + 'release_name=s' => \$release_name, + 'rebuild' => \$rebuild, # rebuild directory if it exists + 'no-update' => \$no_update, + 'verbose|v' => \$verbose, +) or pod2usage (2); + +pod2usage( -msg => "Required options: --group_id --group_type --release_name", + -exitval => 3) + unless $group_id and $release_name and $group_type ; + +if ($group_type eq 'lap') { + pod2usage( -msg => "--lap_id is required with --group_type lap", + -exitval => 3) + unless $lap_id; + $group_name = "lap_$lap_id"; +} else { + pod2usage( -msg => "--group_name is required with --group_type $group_type", + -exitval => 3) + unless $group_name; +} + +my $missing_tools; +my $releasetool = can_run('releasetool') or (warn "Can't find releasetool" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $ipprc = PS::IPP::Config->new() or &my_die("Unable to set up", $group_id, $PS_EXIT_CONFIG_ERROR); + +# XXX: get this from site.config +my $exposureListRoot = "/data/ippc17.0/www/ipp-misc/ps1-data/single-frame"; + +my $outputBase = "$exposureListRoot/$release_name"; + +if (!-e $outputBase) { + mkdir $outputBase or &my_die("Failed to create $outputBase", $group_id, $PS_EXIT_SYS_ERROR); +} + +my $outdir = "$outputBase/$group_name"; +if (-e $outdir) { + if ($rebuild) { + my $rc = system "rm -rf $outdir"; + if ($rc) { + my $status = $rc >> 8; + my_die("failed to remove existing directory $outdir: $rc $status", $group_id, $PS_EXIT_UNKNOWN_ERROR); + } + } else { + my_die("directory $outdir already exists and --rebuild not supplied", $group_id, $PS_EXIT_UNKNOWN_ERROR); + } +} + +mkdir $outdir or my_die ("failed to create $outdir", $group_id, $PS_EXIT_UNKNOWN_ERROR); + +my $oh; +my $outfile = "$outdir/index.html"; +open $oh, ">$outfile" or my_die("failed to open $outfile", $group_id, $PS_EXIT_UNKNOWN_ERROR); + +my $oh2; +my $outfile2 = "$outdir/index.txt"; +open $oh2, ">$outfile2" or my_die("failed to open $outfile2", $group_id, $PS_EXIT_UNKNOWN_ERROR); + +my $title = "PS1 Exposure List for"; +if ($group_type eq 'lap') { + $title .= " $release_name LAP run $lap_id"; +} else { + $title .= " $group_name"; +} + +my $head = " + + +$title + + +

$title +

+
+Up +
+
+ +"; + +print $oh "$head\n"; + + +# find all exposures in this relGroup +my $query = " +SELECT + exp_name, + exp_id, + obs_mode, + filter, + DEGREES(ra) as RA, + DEGREES(decl) AS 'DEC', + dateobs AS 'Date Time (UTC)', + comment +FROM + relGroup JOIN relExp USING(group_id) join rawExp USING(exp_id) + JOIN camRun USING(cam_id) JOIN camProcessedExp using(cam_id) +WHERE + group_id = $group_id + and camProcessedExp.quality = 0 AND camProcessedExp.fault = 0; +"; + +my $dbh = open_db(); +my $stmt = $dbh->prepare($query); + +$stmt->execute() or my_die("failed to execute query: $stmt->errstr\n", $group_id, $PS_EXIT_UNKNOWN_ERROR); + +printf STDERR "%4d exposures in group for $group_name\n", $stmt->rows; + +# $stmt->dump_results(1000); + +# start the table with the header fields +print $oh "\n"; +print $oh2 "# "; + +my $headings = $stmt->{NAME}; +my $numcols = $stmt->{NUM_OF_FIELDS}; +for (my $col = 0; $col < scalar @$headings; $col++) { + print $oh "\n"; + print $oh2 "$headings->[$col]|"; + if ($col == 0) { + # add a column + print $oh "\n"; + print $oh2 "geturl|"; + } +} +print $oh "\n"; +print $oh2 "\n"; + +# my $hostname = hostname(); +my $get_link_fmt = "/getsmf.php?exp_name=%s&release=$release_name"; +my $link_fmt = "Get smf"; +while (my $row = $stmt->fetchrow_arrayref()) { + my $exp_name = $row->[0]; + print $oh ""; + for (my $i=0; $i < $numcols; $i++) { + my $val = $row->[$i]; + $val = 'null' if !defined $val; + my $column = $headings->[$i]; + if ($column eq 'filter') { + $val = ' ' . (substr $val, 0, 1) . ' '; + } elsif ($column eq 'RA' or $column eq 'DEC') { + $val = 0 if $val eq 'null'; + $val = sprintf "%9.6f", $val; + } + + my $align; + my $extra; + if ($column eq 'comment') { + $align = 'left'; + } else { + $align = 'center'; + } + + print $oh " "; + print $oh2 "$val|"; + if ($i == 0) { + # add the link column + my $getsmf = sprintf $get_link_fmt, $exp_name; + print $oh2 " $getsmf "; + + my $html_link = sprintf $link_fmt, $getsmf; + print $oh " "; + } + } + print $oh "\n"; + print $oh2 "\n"; +} +print $oh "\n
$headings->[$col]Retrieve
$val$html_link
\n"; +print $oh "\n\n"; + +close $oh; +close $oh2; + +print STDERR "build exposure lists for group_id $group_id in $outdir\n"; +{ + my $command = "$releasetool -updaterelgroup"; + $command .= " -group_id $group_id"; + $command .= " -set_exp_list_path $outdir"; + $command .= ' -set_state full'; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = $error_code >> 8; + my_die("failed to run $command $error_code\n", $group_id, $error_code); + } + } else { + print STDERR "Skipping $command\n"; + } +} + + +exit (0); + +# All done. + +sub open_db { + # XXX Use site.config + my $dbserver = "ippdb01"; + my $dbname = "gpc1"; + my $dbuser = "ipp"; + my $dbpassword = "ipp"; + + my $dsn = "DBI:mysql:host=$dbserver;database=$dbname"; + + my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) + or my_die("Cannot connect to database.\n", $group_id, $PS_EXIT_UNKNOWN_ERROR); + + return $dbh; +} + +sub my_die +{ + my $msg = shift; + my $group_id = shift; + my $exit_code = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless $exit_code; + + carp($msg); + + my $command = "$releasetool -updaterelgroup"; + $command .= " -group_id $group_id"; + $command .= " -set_fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = $error_code >> 8; + carp("failed to run $command $error_code\n", $error_code); + exit $error_code; + } + } else { + print STDERR "Skipping $command\n"; + } + exit $exit_code; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/remote_md5sum.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/remote_md5sum.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/remote_md5sum.pl (revision 41105) @@ -0,0 +1,30 @@ +#! /usr/bin/env perl + +use warnings; +use strict; + +#my $time = time(); +my $filename = shift(@ARGV); + +unless (defined($filename)) { + die; +} + +open(LA,"/proc/loadavg"); # possibly not portable. +my $load = (split /\s+/, )[0]; +close(LA); + +if ($load > 30) { + my $sleep_dur = int($load - 8); + +# print STDERR "$load $sleep_dur $time\n"; +# $time = time(); +# print STDERR "$time\n"; + sleep($sleep_dur); +# $time = time(); +# print STDERR "RESUME $time\n"; +} +my $response = `md5sum $filename`; +print $response; +#$time = time(); +#print STDERR "END $time\n"; Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_check_diff.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_check_diff.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_check_diff.pl (revision 41105) @@ -0,0 +1,55 @@ +#! /usr/bin/env perl +use Carp; +use warnings; +use strict; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +#my $remote_root = '/scratch3/watersc1/'; + +my ($diff_id,$skycell_id,$dbname,$out_path_base, $remote_root); +GetOptions( + 'diff_id=s' => \$diff_id, + 'skycell_id=s' => \$skycell_id, + 'dbname=s' => \$dbname, + 'out_path_base=s' => \$out_path_base, + 'remote_root=s' => \$remote_root, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Required options: --out_path_base --remote_root", -exitval => 3) unless + defined($out_path_base) && + defined($diff_id) && + defined($skycell_id) && + defined($remote_root) && + defined($dbname); + +my $counter = 0; + +foreach my $file (@ARGV) { + my $error = 0; + + #header + + # check each file against its possible locations, incrementing the error counter if not found + $error = do_checks($file); + + if ($error != 0) { + open(DB,">${out_path_base}.dbinfo"); + print DB "difftool -adddiffskyfile -diff_id ${diff_id} -skycell_id ${skycell_id} -dbname ${dbname} -quality 4242\n"; + close(DB); + print "Failed to find required file $file for $diff_id $skycell_id\n"; + exit(1); + } + + $counter++; +} + +sub do_checks { + my ($cfile) = @_; + if (! ((-e $cfile)&&(-s $cfile))) { # This cfile does not exist or is zero size. + return(1); + } + return(0); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_mk_stack_mdc.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_mk_stack_mdc.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_mk_stack_mdc.pl (revision 41105) @@ -0,0 +1,85 @@ +#! /usr/bin/env perl +use Carp; +use warnings; +use strict; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +#my $remote_root = '/scratch3/watersc1/'; + +my ($compmap_file,$remote_root); +GetOptions( + 'compmap=s' => \$compmap_file, + 'remote_root=s' => \$remote_root, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Required options: --compmap", -exitval => 3) unless + defined($remote_root) and + defined($compmap_file); + +my %component_map = (); +open(CM,$compmap_file) || die "Cannot find requested compmap file"; +while() { + chomp; + my ($symbolic_name,$disk_name) = split /\s+/; + $component_map{$symbolic_name} = $disk_name; +} +close(CM); + +my $counter = 0; + +foreach my $path_base (@ARGV) { + my $mdc_content = ""; + my $file = ""; + my $error = 0; + +# print "PB: $path_base\n"; + + #header + $mdc_content .= "INPUT${counter} METADATA\n"; + + # check each file against its possible locations, incrementing the error counter if not found + $file = do_checks("${path_base}.fits",$error); + $mdc_content .= " IMAGE STR $file\n"; + + $file = do_checks("${path_base}.mask.fits",$error); + $mdc_content .= " MASK STR $file\n"; + + $file = do_checks("${path_base}.wt.fits",$error); + $mdc_content .= " VARIANCE STR $file\n"; + + $file = do_checks("${path_base}.psf",$error); + $mdc_content .= " PSF STR $file\n"; + + $file = do_checks("${path_base}.cmf",$error); + $mdc_content .= " SOURCES STR $file\n"; + + # This is static, and isn't used by ppStack, but I believe needs to exist in the mdc. 2014-08-28 czw + $mdc_content .= " BKGMODEL STR ${path_base}.mdl.fits\n"; + $mdc_content .= "END\n\n"; +# print "MDC: $mdc_content\n"; + # If we had no errors, print it and move on. + if ($error == 0) { + print $mdc_content; + } + + $counter++; +} + +sub do_checks { + my ($cfile,$error) = @_; +# print ">$cfile<\n"; + if (! ((-e $cfile)&&(-s $cfile))) { # This cfile does not exist or is zero size. + my $disk = $component_map{$cfile}; + $cfile = "${disk}"; + if (! ((-e $cfile)&&(-s $cfile))) { # The other expected cfile did not exist. +# $cfile = ''; + $error++; + die "Missing cfile $cfile!"; + } + } + return($cfile); +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_mk_staticsky_mdc.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_mk_staticsky_mdc.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_mk_staticsky_mdc.pl (revision 41105) @@ -0,0 +1,94 @@ +#! /usr/bin/env perl +use Carp; +use warnings; +use strict; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +#my $remote_root = '/scratch3/watersc1/'; + +my ($compmap_file, $remote_root); +GetOptions( + 'compmap=s' => \$compmap_file, + 'remote_root=s' => \$remote_root, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Required options: --compmap", -exitval => 3) unless + defined($remote_root) and + defined($compmap_file); + +if (($#ARGV + 1) % 2 != 0) { + die "Do not have a matched pair of path_base/stack_id values $#ARGV"; +} + +my %component_map = (); +open(CM,$compmap_file) || die "Cannot find requested compmap file"; +while() { + chomp; + my ($symbolic_name,$disk_name) = split /\s+/; + $symbolic_name =~ s%//%/%g; + $disk_name =~ s%//%/%g; + $component_map{$symbolic_name} = $disk_name; +} +close(CM); + +my $counter = 0; + + +my $mdc_content .= "INPUT MULTI\n"; +print $mdc_content; + + +for (my $index = 0; $index <= $#ARGV; $index += 2) { + my $path_base = $ARGV[$index]; + my $stack_id = $ARGV[$index+1]; + my $mdc_content = ""; + my $file = ""; + my $error = 0; + $path_base =~ s%//%/%g; + + #header + $mdc_content .= "INPUT METADATA\n"; + $mdc_content .= " STACK_ID S64 " . $stack_id . "\n"; + + # check each file against its possible locations, incrementing the error counter if not found + $file = do_checks("${path_base}.unconv.fits",$error); + $mdc_content .= " RAW:IMAGE STR $file\n"; + + $file = do_checks("${path_base}.unconv.mask.fits",$error); + $mdc_content .= " RAW:MASK STR $file\n"; + + $file = do_checks("${path_base}.unconv.wt.fits",$error); + $mdc_content .= " RAW:VARIANCE STR $file\n"; + + $file = do_checks("${path_base}.unconv.num.fits",$error); + $mdc_content .= " RAW:EXPNUM STR $file\n"; + + $mdc_content .= "END\n\n"; + + # If we had no errors, print it and move on. + if ($error == 0) { + print $mdc_content; + } + + $counter++; +} + +sub do_checks { + my ($cfile,$error) = @_; +# print STDERR ">$cfile<\n"; + if (! ((-e $cfile)&&(-s $cfile))) { # This cfile does not exist or is zero size. + my $disk = $component_map{$cfile}; + $cfile = "${disk}"; + if (! ((-e $cfile)&&(-s $cfile))) { # The other expected cfile did not exist. +# $cfile = ''; +# $cfile = $disk; + $error++; + die "Missing cfile $cfile ($disk) $mdc_content!"; + } + } + return($cfile); +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_camera.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_camera.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_camera.pl (revision 41105) @@ -0,0 +1,383 @@ +#! /usr/bin/env perl + +# generate the input & output files lists and commands for a single camRun + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; +use File::Temp qw( tempfile ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($remote_id,$cam_id,$camera,$dbname,$verbose,$path_base,$no_update,$cmd_recipe); +GetOptions( + 'remote_id=s' => \$remote_id, + 'cam_id=s' => \$cam_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --cam_id --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($cam_id) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname); + + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + + +# my $remote_root = '/lustre/scratch1/turquoise/watersc1/ps1/'; # Far side destination base location +my $remote_root = $remote_recipe{REMOTE_ROOT}; +my $remote_hostname = $remote_recipe{REMOTE_HOSTNAME}; # Name of the remote node. +my $threads_req = 0; # How many threads are we going to use? + +my $fail_state = "prep_fail"; + + +my $ipprc = PS::IPP::Config->new( $camera ) or &my_die( "Unable to set up", $remote_id, $cam_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my @return_component_list = ("DBINFO.EXP", "PSASTRO.CONFIG", "PSASTRO.OUTPUT", "LOG.EXP", "PSASTRO.STATS"); + +# STEP 0: Open output files +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my (undef, $remote_config) = &uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$remote_id, $cam_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $cam_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $cam_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate",$remote_id, $cam_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $cam_id, $PS_EXIT_SYS_ERROR, $fail_state); +my %file_filter = (); + +my $job_index = 0; + +# STEP 1: Get exposure level information for this camRun +my ($workdir,$exp_tag,$reduction); +{ + +### $command = "$camtool -processedexp -cam_id $cam_id "; ### THIS LINE ONLY TO TEST! + my $command = "$camtool -pendingexp -cam_id $cam_id "; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("Unable to run camtool to determine stage parameters.", $remote_id, $cam_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine cam component information.", $remote_id, $cam_id, $PS_EXIT_PROG_ERROR, $fail_state); + my $metadata = parse_md_list($MDlist); + my $camEntry = $metadata->[0]; + + $workdir = $camEntry->{workdir}; + $exp_tag = $camEntry->{exp_tag}; + $reduction = $camEntry->{reduction}; + $reduction = 'DEFAULT' unless defined $reduction; + unless (defined($workdir)) { + while( my ($k, $v) = each %$camEntry ) { + print "key: $k, value: $v.\n"; + } + print "%{ $camEntry }\n"; + die; + } +} + +my $ipp_outroot = "${workdir}/${exp_tag}/${exp_tag}.cm.${cam_id}"; +my $remote_outroot = uri_local_to_remote($ipp_outroot); + +# Step 3: Iterate over the sub-components +{ + my $command = "$camtool -pendingimfile -cam_id $cam_id "; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run camtool -pendingimfile ", $remote_id, $cam_id, $error_code, $fail_state); + } + + # We don't actually care about the input cam data other than to know which mask files to instantiate. + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine cam component information.", $remote_id, $cam_id, $PS_EXIT_PROG_ERROR, $fail_state); + + my $metadata = parse_md_list($MDlist); + my $chipProto = $metadata->[0]; + my $chip_path = $chipProto->{path_base}; + my $remote_chip_path = &uri_local_to_remote( $chip_path ); + my $pre_cmd_cmfs = "ls -1 ${remote_chip_path}*.cmf > ${remote_outroot}.cmflist"; + my $pre_cmd_masks= "ls -1 ${remote_chip_path}*.mk.fits > ${remote_outroot}.masklist"; + + # Despite the previous comment, we do care about the output of pendingimfile, as that + # contains information for the exposure. + my ($statFile, $statName) = tempfile( "/tmp/cm.$cam_id.stats.XXXX", UNLINK => 1 ); + foreach my $line (@$stdout_buf) { + print $statFile $line; + } + close $statFile; + + # parse the stats in the metadata file + $command = "$ppStatsFromMetadata $statName - CAMERA_EXP_IMFILE"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform ppStatsFromMetadata: $error_code\n"); + exit($error_code); + } + + my $results = ''; + foreach my $line (@$stdout_buf) { + $results .= " $line"; + } + chomp($results); + + + + my $recipe_psastro = $ipprc->reduction($reduction, 'PSASTRO'); # Recipe to use + if ($recipe_psastro eq "") { + &my_die("Unable to determine PSASTRO recipe", $cam_id, $PS_EXIT_PROG_ERROR); + } + + my $psastro_command = " psastro -list ${remote_outroot}.cmflist "; + $psastro_command .= " -masklist ${remote_outroot}.masklist ${remote_outroot} "; +# $psastro_command .= " -refmasklist ${remote_outroot}.masklist ${remote_outroot} "; + $psastro_command .= " -refmasklist /turquoise/usr/projects/ps1/watersc1/references/gpc1.refmask.list "; + $psastro_command .= " -kh-correct /turquoise/usr/projects/ps1/watersc1/references/khcorrect.20140606.v0.fits "; +# $psastro_command .= " -astrommodel /turquoise/usr/projects/ps1/watersc1/references/gpc1.20080909.asm "; + $psastro_command .= " -astrommodel /turquoise/usr/projects/ps1/watersc1/references/gpc1.20140505.asm "; + $psastro_command .= " -recipe PSASTRO $recipe_psastro "; + $psastro_command .= " -tracedest ${remote_outroot}.trace -log ${remote_outroot}.log "; + $psastro_command .= " -dumpconfig ${remote_outroot}.psastro.mdc -stats ${remote_outroot}.stats "; + $psastro_command .= " -recipe PPSTATS CAMSTATS "; + + my $camtool_post_cmd = "camtool -cam_id $cam_id -addprocessedexp -uri UNKNOWN "; + $camtool_post_cmd .= " -dbname $dbname " if defined $dbname; + $camtool_post_cmd .= " -path_base $ipp_outroot -hostname $remote_hostname -dtime_script 0 "; + $camtool_post_cmd .= " $results "; # Add exposure information + my $post_cmd_echo = " echo -n \"$camtool_post_cmd\" > ${remote_outroot}.dbinfo "; + my $post_cmd_SfM = " ppStatsFromMetadata ${remote_outroot}.stats - CAMERA_EXP_FPA >> ${remote_outroot}.dbinfo "; + + print CONFIG "${pre_cmd_cmfs} && ${pre_cmd_masks} && ${psastro_command} && ${post_cmd_echo} && ${post_cmd_SfM} "; + $job_index++; + + # Determine which output files need to be returned + foreach my $component(@return_component_list) { + my $filename = $ipprc->filename($component,$ipp_outroot); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + foreach my $chipInfo (@{ $metadata }) { + my $filename = $ipprc->filename("PSASTRO.OUTPUT.MASK",$ipp_outroot,$chipInfo->{class_id}); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + print CONFIG "\n"; +} +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +unless($no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $cam_id "; + $command .= " -set_jobs $job_index"; + $command .= " -set_path_base $path_base"; + $command .= " -set_state prep_done"; + $command .= " -dbname $dbname " if defined $dbname; + system($command); +} + +exit (0); + +## Common SC routines + +sub uri_convert { # (ipp_disk,remote_disk) = uri_convert(neb_uri); + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $cam_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_convert_and_create { # (ipp_disk,remote_disk) = uri_convert_and_create(neb_uri); ipp_disk is created if it doesn't exist + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri , 1); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $cam_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { # (ipp_disk,remote_disk) = uri_to_output(neb_uri); Appends to TRANSFER and CHECK filehandles + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + + unless (exists($file_filter{$neb_uri})) { + $file_filter{$neb_uri} = 1; + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + } + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs_for_return { # (ipp_disk,remote_disk) = uri_to_outputs_for_return(neb_uri); create ipp_disk, append to RETURN and GENERATE + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert_and_create( $neb_uri ); + unless (exists($file_filter{$neb_uri})) { + $file_filter{$neb_uri} = 1; + print RETURN "$ipp_disk\n"; + print GENERATE "$remote_disk\n"; + } + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { #(remote_uri) = uri_local_to_remote(local_neb_uri); + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { #(local_neb_uri) = uri_remote_to_local(remote_uri); + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} + + +sub my_die { # exit with status; my_die(message,stage_id,exit_code,exit_status); + my $msg = shift; + my $remote_id = shift; + my $stage_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and defined $stage_id and not $no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stage_id"; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_chip.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_chip.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_chip.pl (revision 41105) @@ -0,0 +1,494 @@ +#! /usr/bin/env perl + +# generate the input & output files lists and commands for a single chipRun + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Look for programs we need +my $missing_tools; +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $detselect= can_run('detselect') or (warn "Can't find detselect" and $missing_tools = 1); +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $ipp_burntool_fix = can_run('ipp_apply_burntool_fix.pl') or (warn "Can't find ipp_apply_burntool_fix.pl" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Options +my ($remote_id,$chip_id,$camera,$dbname,$path_base,$no_update,$verbose,$dbverbose,$cmd_recipe); +GetOptions( + 'remote_id=s' => \$remote_id, + 'chip_id=s' => \$chip_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + 'dbverbose' => \$dbverbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --chip_id --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($chip_id) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname); + + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + + +# my $remote_root = '/lustre/scratch1/turquoise/watersc1/ps1/'; # Far side destination base location +my $remote_root = $remote_recipe{REMOTE_ROOT}; +my $remote_hostname = $remote_recipe{REMOTE_HOSTNAME}; # Name of the remote node. +my $remote_raw = "${remote_root}/tmp/"; # Directory to find raw data in. +my $threads_req = 4; + +my $fail_state = "prep_fail"; +my $hard_fail_state = "fail"; + +my $ipprc = PS::IPP::Config->new( $camera ) or &my_die( "Unable to set up", $remote_id, $chip_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Detrend concept holders (name, ppImage option) +my %det_types = ( + 'MASK' => '-mask', + 'FLAT' => '-flat', + 'DARK' => '-dark', + 'VIDEODARK' => '-dark', + 'LINEARITY' => '-linearity', + 'FRINGE' => '-fringe', + 'NOISEMAP' => '-noisemap' + ); + +my @return_component_list = ("DBINFO.IMFILE","PPIMAGE.STATS","LOG.IMFILE","PPIMAGE.BACKMDL","PPIMAGE.PATTERN"); + +# STEP 0: Open output files +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my (undef, $remote_config) = uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer", $remote_id, $chip_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $chip_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $chip_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate", $remote_id, $chip_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $chip_id, $PS_EXIT_SYS_ERROR, $fail_state); + +my $job_index = 0; + +# STEP 1 : Get exposure level information for this chipRun +my ($exp_id, $filter, $altfilt, $dateobs); +{ + my $command = "$chiptool -listrun -chip_id $chip_id "; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $dbverbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("Unable to run chiptool to determine stage parameters.", $remote_id, $chip_id, $error_code, $fail_state); + } + + # Parse chipRun level data to determine exposure information + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine chip component information.", $remote_id, $chip_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + my $metadata = parse_md_list($MDlist); + my $chipEntry = $metadata->[0]; + + $exp_id = $chipEntry->{exp_id}; + $filter = $chipEntry->{filter}; + $altfilt = $filter; + $altfilt =~ s/.00000//; + $dateobs = $chipEntry->{dateobs}; +} + +# STEP 2 : select the det_ids for each desired det_type (appropriate to this exposure) +my %det_ids = (); +my %det_iters = (); + +foreach my $det_type (keys (%det_types)) { + if (($filter !~ /y/) && ($det_type eq 'FRINGE')) { next; } # We can skip fringe for all but y + + my $command = "detselect -search -det_type $det_type -time $dateobs"; + $command .= " -dbname $dbname " if defined($dbname); + + if (($det_type eq 'FLAT') || ($det_type eq 'FRINGE')) { + $command .= " -filter $altfilt"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $dbverbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("No valid detrend available for this image: $det_type", $remote_id, $chip_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Could not parse detrend information for this image: $det_type", $remote_id, $chip_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + my $metadata = parse_md_list($MDlist); + my $detEntry = $metadata->[0]; + + if ($verbose) { + print STDERR "det_id: $detEntry->{det_id}\n"; + print STDERR "det_iter: $detEntry->{iteration}\n"; + } + + # save det_id and iteration + $det_ids{$det_type} = $detEntry->{det_id}; + $det_iters{$det_type} = $detEntry->{iteration}; +} + +# Step 3: Iterate over the sub-components +{ + # select chipProcessedImfile entries + my $command = "$chiptool -pendingimfile -chip_id $chip_id"; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $dbverbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("Unable to run chiptool -pendingimfile", $remote_id, $chip_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse chiptool -pendingimfile information.", $remote_id, $chip_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + my $metadata = parse_md_list($MDlist); + + # Iterate over the chipProcessedImfile level data. + foreach my $chipEntry (@$metadata) { + # Get information we need to pass to ppImage + my $uri = $chipEntry->{uri}; + my $class_id = $chipEntry->{class_id}; + my $video_cells = $chipEntry->{video_cells}; + my $reduction = $chipEntry->{reduction}; + my $exp_tag = $chipEntry->{exp_tag}; + my $workdir = $chipEntry->{workdir}; + my $chip_imfile_id = $chipEntry->{chip_imfile_id}; + + # Process the image and burntool table + # IMAGE CHECK: Look up the image location, prove it exists, and if not, abort the prep for this object. + my ($ipp_uri, $remote_uri) = uri_convert($uri); + unless (-e $ipp_uri) { + # Try to fix it. + system("neb-repair $uri"); + ($ipp_uri, $remote_uri) = uri_convert($uri); + unless (-e $ipp_uri) { + # This image file is missing, so it will require manual intervention. + &my_die("Required image file $ipp_uri ($chip_id, $class_id) not found. Stopping this prep.", + $remote_id,$chip_id,$PS_EXIT_CONFIG_ERROR,$hard_fail_state); + } + } + + # The image exists, so continue. This resets the variables, but also outputs the file locations. + ($ipp_uri, $remote_uri) = uri_to_outputs_raw($uri); + my $btt = $uri; + $btt =~ s/fits$/burn.tbl/; + + # Check burntool table for existance, and if it doesn't, regenerate it. + my ($ipp_btt, $remote_btt) = uri_convert($btt); + unless (-e $ipp_btt) { + my $exp_name = $chipEntry->{exp_name}; + my $burntool_command = "$ipp_burntool_fix --exp_name $exp_name --class_id $class_id"; + $burntool_command .= " -dbname $dbname" if defined($dbname); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $burntool_command, verbose => $dbverbose); + # That command repairs the tables, but the instance we learned about may not be correct. + # Look up the new one. + ($ipp_btt, $remote_btt) = uri_convert($btt); + + unless (-e $ipp_btt) { + &my_die("Attempted regeneration of burntool table ($chip_id, $class_id) has failed. Stopping this prep.", + $remote_id,$chip_id, $PS_EXIT_CONFIG_ERROR, $hard_fail_state); + } + } + ($ipp_btt, $remote_btt) = uri_to_outputs_raw($btt); + + # Initialize the ppI command + my $ppImage_command = "ppImage -file $remote_uri"; + $ppImage_command .= " -burntool $remote_btt "; + + foreach my $det_type (keys (%det_types)) { + if (( $video_cells) && ($det_type eq 'DARK')) { next; } + if ((!$video_cells) && ($det_type eq 'VIDEODARK')) { next; } + + my $det_id = $det_ids{$det_type}; + my $det_iter = $det_iters{$det_type}; + + if (not defined $det_id) { next; } + + if ($verbose) { print STDERR "det_type, det_id, det_iter: $det_type, $det_id, $det_iter\n"; } + + # Add detrend information to the command line + my $detselect_command = "detselect -select "; + $detselect_command .= " -det_id $det_id"; + $detselect_command .= " -iteration $det_iter"; + $detselect_command .= " -class_id $class_id"; + $detselect_command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $detselect_command, verbose => $dbverbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("No valid detrend available for this image: $det_type $det_id $det_iter", $remote_id, $chip_id, $error_code, $fail_state); + } + + my $detMDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Could not parse detrend information for this image: $det_type $det_id $det_iter", $remote_id, $chip_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + my $detImfileMD = parse_md_list($detMDlist); + my $detImfile = $detImfileMD->[0]; + my $duri = $detImfile->{uri}; + + my $det_code = $det_types{$det_type}; + my ($ipp_det_uri, $remote_det_uri) = uri_to_outputs_raw($duri); + $ppImage_command .= " $det_code $remote_det_uri "; + } + + # Add output root + my $ipp_outroot = "${workdir}/${exp_tag}/${exp_tag}.ch.${chip_id}"; + my $remote_outroot = uri_local_to_remote($ipp_outroot); + $ppImage_command .= " $remote_outroot "; + print STDERR "$remote_outroot $ipp_outroot $class_id\n"; + # Complete reduction information. + $reduction = 'DEFAULT' unless defined $reduction; + my $recipe_ppImage = $ipprc->reduction($reduction, 'CHIP_PPIMAGE'); # Recipe to use for ppImage + my $recipe_psphot = $ipprc->reduction($reduction, 'CHIP_PSPHOT'); # Recipe to use for psphot + + $ppImage_command .= " -recipe PPIMAGE $recipe_ppImage "; + $ppImage_command .= " -recipe PSPHOT $recipe_psphot "; + $ppImage_command .= " -recipe PPSTATS CHIPSTATS -stats ${remote_outroot}.${class_id}.stats "; + $ppImage_command .= " -threads $threads_req "; + $ppImage_command .= " -image_id $chip_imfile_id "; + $ppImage_command .= " -tracedest ${remote_outroot}.${class_id}.trace "; + $ppImage_command .= " -log ${remote_outroot}.${class_id}.log "; + + # Calculate pre and post commands + my $remote_outroot_dir = dirname($remote_outroot); + my $pre_command = "mkdir -p $remote_outroot_dir"; + + my $post_commandA = "chiptool -addprocessedimfile -exp_id $exp_id -chip_id $chip_id -class_id $class_id "; + $post_commandA .= " -uri ${ipp_outroot}.ch.${class_id}.ch.fits -path_base $ipp_outroot "; + $post_commandA .= " -magicked 0 -hostname $remote_hostname -dtime_script 0 "; + $post_commandA .= " -dbname $dbname " if defined $dbname; + + my $post_commandB = "echo -n \"$post_commandA\" > ${remote_outroot}.${class_id}.dbinfo "; + my $post_commandC = "ppStatsFromMetadata ${remote_outroot}.${class_id}.stats - CHIP_IMFILE >> ${remote_outroot}.${class_id}.dbinfo"; + + $job_index++; + + print CONFIG "${pre_command} && ${ppImage_command} && ${post_commandB} && ${post_commandC}"; + + # Determine which output files need to be returned. + foreach my $component (@return_component_list) { + my $filename = $ipprc->filename($component, $ipp_outroot, $class_id); + my ($ipp_disk, $remote_disk) = uri_to_outputs_for_return( $filename ); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + print CONFIG "\n"; + } +} + +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +## We're done here. The execution and handling are done elsewhere. +# Quick review: +# new -> pending -> run -> full +# auth +unless($no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $chip_id "; + $command .= " -set_jobs $job_index"; + $command .= " -set_path_base $path_base"; + $command .= " -set_state prep_done"; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} +exit (0); + +sub uri_convert { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $chip_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_convert_and_create { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri , 1); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $chip_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs_raw { + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + $remote_disk = $remote_raw . $ipp_disk; + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs_for_return { + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert_and_create( $neb_uri ); + print RETURN "$ipp_disk\n"; + print GENERATE "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} + +sub my_die { + my $msg = shift; + my $remote_id = shift; + my $stage_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and defined $stage_id and not $no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stage_id"; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_diff.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_diff.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_diff.pl (revision 41105) @@ -0,0 +1,410 @@ +#! /usr/bin/env perl + +# generate the input & output files lists and commands for a single diffRun + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($remote_id,$diff_id,$camera,$dbname,$verbose,$path_base,$no_update,$cmd_recipe); +GetOptions( + 'remote_id=s' => \$remote_id, + 'diff_id=s' => \$diff_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id -diff_id --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($diff_id) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname); + + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + +# my $remote_root = '/lustre/scratch1/turquoise/watersc1/ps1/'; # Far side destination base location +my $remote_root = $remote_recipe{REMOTE_ROOT}; +my $remote_hostname = $remote_recipe{REMOTE_HOSTNAME}; # Name of the remote node. +my $threads_req = 4; # How many threads are we going to use? + +my $fail_state = "prep_fail"; + + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $remote_id, $diff_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my @return_component_list = ("DBINFO.EXP", "PPSUB.CONFIG", "LOG.EXP","TRACE.EXP","SKYCELL.STATS","PPSUB.OUTPUT.KERNELS", + "PPSUB.OUTPUT.SOURCES", "PPSUB.INVERSE.SOURCES", + "PSPHOT.BACKMDL.MEF", "PSPHOT.PSF.SKY.SAVE"); + +# STEP 0: Open output files +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my (undef, $remote_config) = &uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate",$remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state); + +my $job_index = 0; + +# STEP 1: Get exposure level information from the diffRun we're working from. +my ($diffRun,$diffData,%diffHash); +{ + # Get the Run level information first. + my $command = "$difftool -todiffskyfile -diff_id $diff_id "; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run difftool -todiffskyfile ", $remote_id, $diff_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine diff run information.", $remote_id, $diff_id, $PS_EXIT_PROG_ERROR, $fail_state); + $diffRun = parse_md_list($MDlist); + + + # This actually returns all the individual diff/skyfiles that comprise this run. Because consistency. + $command = "$difftool -inputskyfile -diff_id $diff_id "; + $command .= " -dbname $dbname " if defined($dbname); + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run difftool -pendingimfile ", $remote_id, $diff_id, $error_code, $fail_state); + } + + $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine diff component information.", $remote_id, $diff_id, $PS_EXIT_PROG_ERROR, $fail_state); + $diffData = parse_md_list($MDlist); + + # Because this query returns a horrible decision, link the warp element and the stack element together. + foreach my $diffEntry ( @{ $diffData } ) { + my $skycell_id = $diffEntry->{skycell_id}; + my $template_v = $diffEntry->{template}; + + if (defined($diffHash{$skycell_id}{$template_v})) { + &my_die("I have found too many entries for skycell: $skycell_id and template: $template_v.", + $remote_id, $diff_id, $PS_EXIT_PROG_ERROR, $fail_state); + } + + $diffHash{$skycell_id}{$template_v} = $diffEntry; + } +} + +# STEP 2: Iterate over the sub-components +{ +# foreach my $diffEntry ( @{ $diffData } ) { + + my $diffRun_prototype = ${ $diffRun }[0]; + my $reduction = $diffRun_prototype->{reduction}; + my $workdir = $diffRun_prototype->{workdir}; + my $bothwaps = $diffRun_prototype->{bothways}; + my $tess_id = $diffRun_prototype->{tess_id}; + + +# my $recipe_ppSub = $ipprc->reduction($reduction, 'DIFF_PPSUB'); +# my $recipe_psphot= $ipprc->reduction($reduction, 'DIFF_PSPHOT'); +# my $recipe_ppstats= 'DIFFSTATS'; +# &my_die("Unable to find recipes for reduction $reduction", +# $remote_id, $diff_id, $PS_EXIT_CONFIG_ERROR, $fail_state) +# unless ((defined($recipe_ppSub))&&(defined($recipe_psphot))); + + + foreach my $diffRun_entry (@{ $diffRun }) { + my $skycell_id = $diffRun_entry->{skycell_id}; + my $path_base = $diffRun_entry->{path_base}; + my $diff_skyfile_id = $diffRun_entry->{diff_skyfile_id}; + + my $input = $diffHash{$skycell_id}{0}; # This is the warp + my $template = $diffHash{$skycell_id}{1}; # This is the stack + + # Check that everything matches + unless ((defined($template))&& + (defined($input))&& + ($template->{skycell_id} eq $skycell_id)&& + ($input->{skycell_id} eq $skycell_id)&& + ($template->{tess_id} eq $tess_id)&& + ($input->{tess_id} eq $tess_id)&& + ($template->{camera} eq $input->{camera})) { + &my_die("Something doesn't match or isn't defined for $skycell_id", + $remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state) ; + } + + my $ipp_outroot = "${workdir}/${tess_id}/${skycell_id}/${tess_id}.${skycell_id}.WS.dif.${diff_id}"; + print "$ipp_outroot\n"; + my $remote_outroot = &uri_local_to_remote($ipp_outroot); + + my $ipp_inimage = $ipprc->filename("PSWARP.OUTPUT",$input->{path_base}); + my $ipp_inmask = $ipprc->filename("PSWARP.OUTPUT.MASK",$input->{path_base}); + my $ipp_inwt = $ipprc->filename("PSWARP.OUTPUT.VARIANCE",$input->{path_base}); + my $ipp_insourc = $ipprc->filename("PSWARP.OUTPUT.SOURCES",$input->{path_base}); + + my $remote_inimage = &uri_local_to_remote($ipp_inimage); + my $remote_inmask = &uri_local_to_remote($ipp_inmask); + my $remote_inwt = &uri_local_to_remote($ipp_inwt); + my $remote_insourc = &uri_local_to_remote($ipp_insourc); + + my $ipp_templimage = $ipprc->filename("PPSTACK.UNCONV",$template->{path_base}); + my $ipp_templmask = $ipprc->filename("PPSTACK.UNCONV.MASK",$template->{path_base}); + my $ipp_templwt = $ipprc->filename("PPSTACK.UNCONV.VARIANCE",$template->{path_base}); + #my $ipp_templsourc = $ipprc->filename("PSPHOT.OUT.CMF.MEF",$input->{path_base}); + my $ipp_templsourc = $ipp_insourc; # Just use that everywhere. + + my $remote_templimage = &uri_local_to_remote($ipp_templimage); + my $remote_templmask = &uri_local_to_remote($ipp_templmask); + my $remote_templwt = &uri_local_to_remote($ipp_templwt); + my $remote_templsourc = &uri_local_to_remote($ipp_templsourc); + + my $pre_command = " sc_check_diff.pl --diff_id ${diff_id} --remote_root ${remote_root} --skycell_id ${skycell_id} --dbname ${dbname} --out_path_base ${remote_outroot} $remote_inimage $remote_inmask $remote_inwt $remote_insourc $remote_templimage $remote_templmask $remote_templwt $remote_templsourc "; + + # make any directory we may need + my $remote_outroot_dir = dirname($remote_outroot); + my $dir_command = "mkdir -p $remote_outroot_dir"; + + + # Convert these here + my $psdiff_command = " ppSub ${remote_outroot} "; + $psdiff_command .= " -inimage $remote_inimage -refimage $remote_templimage "; + $psdiff_command .= " -inmask $remote_inmask -refmask $remote_templmask "; + $psdiff_command .= " -invariance $remote_inwt -refvariance $remote_templwt "; + $psdiff_command .= " -insources $remote_insourc -refsources $remote_templsourc "; + $psdiff_command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE "; + $psdiff_command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF "; + $psdiff_command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF "; + $psdiff_command .= " -recipe PPSUB WARPSTACK_PV3 "; + $psdiff_command .= " -recipe PSPHOT DIFF_PV3 "; + $psdiff_command .= " -recipe PPSTATS DIFFSTATS "; + $psdiff_command .= " -tracedest ${remote_outroot}.trace -log ${remote_outroot}.log "; + $psdiff_command .= " -threads $threads_req "; # -image_id ${image_id} -source_id ${source_id} "; + $psdiff_command .= " -recipe PPSTATS DIFFSTATS "; + $psdiff_command .= " -dumpconfig ${remote_outroot}.ppSub.mdc -stats ${remote_outroot}.stats "; +# $psdiff_command .= " -save-inconv "; # I guess? Nope. It makes images we don't plan to transfer back. + $psdiff_command .= " -photometry -inverse "; + $psdiff_command .= " -image_id $diff_skyfile_id "; # I have no clue what this does. + +# print "$psdiff_command \n"; + + my $post_cmd_echo = " echo -n \"difftool -adddiffskyfile -diff_id $diff_id -skycell_id $skycell_id "; + $post_cmd_echo .= " -dbname $dbname " if defined $dbname; +# $post_cmd_echo .= " -uri ${ipp_outroot}.fits "; + $post_cmd_echo .= " -path_base $ipp_outroot -hostname $remote_hostname -dtime_script 0 \" > ${remote_outroot}.dbinfo "; + + my $post_cmd_SfM = " ppStatsFromMetadata ${remote_outroot}.stats - DIFF_SKYCELL >> ${remote_outroot}.dbinfo "; + + print CONFIG " ${dir_command} && ${pre_command} && ${psdiff_command} && ${post_cmd_echo} && ${post_cmd_SfM} "; + $job_index++; + + # Determine which output files need to be returned + foreach my $component(@return_component_list) { + my $filename = $ipprc->filename($component,$ipp_outroot,$skycell_id); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + print CONFIG "\n"; +# die(); + } +} +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +unless($no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $diff_id "; + $command .= " -set_jobs $job_index"; + $command .= " -set_path_base $path_base"; + $command .= " -set_state prep_done"; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} +exit (0); + +## Common SC routines + +sub uri_convert { # (ipp_disk,remote_disk) = uri_convert(neb_uri); + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_convert_and_create { # (ipp_disk,remote_disk) = uri_convert_and_create(neb_uri); ipp_disk is created if it doesn't exist + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri , 1); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $diff_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { # (ipp_disk,remote_disk) = uri_to_output(neb_uri); Appends to TRANSFER and CHECK filehandles + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = &uri_convert( $neb_uri ); + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs_for_return { # (ipp_disk,remote_disk) = uri_to_outputs_for_return(neb_uri); create ipp_disk, append to RETURN and GENERATE + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = &uri_convert_and_create( $neb_uri ); + + print RETURN "$ipp_disk\n"; + print GENERATE "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { #(remote_uri) = uri_local_to_remote(local_neb_uri); + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { #(local_neb_uri) = uri_remote_to_local(remote_uri); + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} + + +sub my_die { # exit with status; my_die(message,stage_id,exit_code,exit_status); + my $msg = shift; + my $remote_id = shift; + my $stage_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and defined $stage_id and not $no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stage_id"; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_ff.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_ff.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_ff.pl (revision 41105) @@ -0,0 +1,362 @@ +#! /usr/bin/env perl + +# generate the input & output files lists and commands for a single ffRun + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $fftool = can_run('fftool') or (warn "Can't find fftool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($remote_id,$ff_id,$camera,$dbname,$verbose,$path_base,$no_update,$cmd_recipe); +GetOptions( + 'remote_id=s' => \$remote_id, + 'ff_id=s' => \$ff_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id -ff_id --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($ff_id) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname); + + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + +# my $remote_root = '/lustre/scratch1/turquoise/watersc1/ps1/'; # Far side destination base location +my $remote_root = $remote_recipe{REMOTE_ROOT}; +my $remote_hostname = $remote_recipe{REMOTE_HOSTNAME}; # Name of the remote node. +my $remote_raw = "${remote_root}/tmp/"; # Directory to find raw data in. + +my $threads_req = 4; # How many threads are we going to use? + +my $fail_state = "prep_fail"; + + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $remote_id, $ff_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my @return_component_list = ("DBINFO.EXP","LOG.EXP","SKYCELL.STATS","TRACE.EXP", + "PSPHOT.OUT.CMF.MEF","PSPHOT.SKY.CONFIG"); + + +# STEP 0: Open output files +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my (undef, $remote_config) = &uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$remote_id, $ff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $ff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $ff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate",$remote_id, $ff_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $ff_id, $PS_EXIT_SYS_ERROR, $fail_state); + +my $job_index = 0; + +# STEP 1: Get exposure level information from the ffRun we're working from. +my ($ffRun); +{ + # Get the Run level information first. + my $command = "$fftool -todo -ff_id $ff_id "; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run fftool -todo ", $remote_id, $ff_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine ff run information.", $remote_id, $ff_id, $PS_EXIT_PROG_ERROR, $fail_state); + $ffRun = parse_md_list($MDlist); +} + +# STEP 2: Iterate over the sub-components +{ + foreach my $ffRun_entry (@{ $ffRun }) { + my $skycell_id = $ffRun_entry->{skycell_id}; + my $tess_id = $ffRun_entry->{tess_id}; + my $workdir = $ffRun_entry->{workdir}; + my $warp_id = $ffRun_entry->{warp_id}; + my $source_pb = $ffRun_entry->{sources_path_base}; + my $warp_pb = $ffRun_entry->{warp_path_base}; + my $reduction = $ffRun_entry->{reduction}; + my $camera = $ffRun_entry->{camera}; + + my $ipp_outroot = sprintf("%s/%s/%s/%s.%s.wrp.%s.ff.%s",$workdir,$tess_id,$skycell_id,$tess_id,$skycell_id,$warp_id,$ff_id); + print "$ipp_outroot\n"; + my $remote_outroot = &uri_local_to_remote($ipp_outroot); + + my $ipp_inimage = $ipprc->filename("PSWARP.OUTPUT",$warp_pb); + my $ipp_inmask = $ipprc->filename("PSWARP.OUTPUT.MASK",$warp_pb); + my $ipp_inwt = $ipprc->filename("PSWARP.OUTPUT.VARIANCE",$warp_pb); + my $ipp_insourc = $ipprc->filename("PSPHOT.OUTPUT.CFF",$source_pb); + +# my ($ipp_disk_inimage, $remote_inimage) = &uri_to_outputs($ipp_inimage); +# my ($ipp_disk_inmask, $remote_inmask) = &uri_to_outputs($ipp_inmask); +# my ($ipp_disk_inwt, $remote_inwt) = &uri_to_outputs($ipp_inwt); +# my ($ipp_disk_insourc, $remote_insourc) = &uri_to_outputs($ipp_insourc); + + my (undef,$remote_inimage) = uri_to_outputs_raw($ipp_inimage); + my (undef,$remote_inmask) = uri_to_outputs_raw($ipp_inmask); + my (undef,$remote_inwt) = uri_to_outputs_raw($ipp_inwt); + my (undef,$remote_insourc) = uri_to_outputs_raw($ipp_insourc); + + # make any directory we may need + my $remote_outroot_dir = dirname($remote_outroot); + my $dir_command = "mkdir -p $remote_outroot_dir"; + + # Find the recipe + $reduction = 'DEFAULT' unless defined $reduction; + my $recipe_psphot = $ipprc->reduction($reduction, 'FULLFORCE_PSPHOT'); # Recipe to use for psphot + unless ($recipe_psphot) { + &my_die("Couldn't find selected reduction for PSPHOT: $reduction\n", + $remote_id,$ff_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + } + + + + # Convert these here + my $psff_command = " psphotFullForce ${remote_outroot} "; + $psff_command .= " -force $remote_insourc "; + $psff_command .= " -file $remote_inimage "; + $psff_command .= " -mask $remote_inmask "; + $psff_command .= " -variance $remote_inwt "; + $psff_command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE "; + $psff_command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF "; + $psff_command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF "; + $psff_command .= " -recipe PSPHOT $recipe_psphot "; + $psff_command .= " -photcode-rule '{DETECTOR}.{FILTER.ID}.ForcedWarp' "; + $psff_command .= " -dumpconfig ${remote_outroot}.psphot.mdc -stats ${remote_outroot}.stats "; + $psff_command .= " -tracedest ${remote_outroot}.trace -log ${remote_outroot}.log "; + $psff_command .= " -threads $threads_req "; # -image_id ${image_id} -source_id ${source_id} "; + + my $post_cmd_echo = " echo -n \"fftool -addresult -ff_id $ff_id -warp_id $warp_id "; + $post_cmd_echo .= " -dbname $dbname " if defined $dbname; +# $post_cmd_echo .= " -uri ${ipp_outroot}.fits "; + $post_cmd_echo .= " -path_base $ipp_outroot -hostname $remote_hostname -dtime_script 0 \" > ${remote_outroot}.dbinfo "; + + my $post_cmd_SfM = " ppStatsFromMetadata ${remote_outroot}.stats - WARP_SKYCELL >> ${remote_outroot}.dbinfo "; + + print CONFIG " ${dir_command} && ${psff_command} && ${post_cmd_echo} && ${post_cmd_SfM} "; + $job_index++; + + # Determine which output files need to be returned + foreach my $component(@return_component_list) { + my $filename = $ipprc->filename($component,$ipp_outroot,$skycell_id); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + # If we're this far, we succeeded, so delete the input files. + print CONFIG " && rm -f $remote_inimage $remote_inmask $remote_inwt "; + print CONFIG "\n"; +# die(); + } +} +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +unless($no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $ff_id "; + $command .= " -set_jobs $job_index"; + $command .= " -set_path_base $path_base"; + $command .= " -set_state prep_done"; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} +exit (0); + +## Common SC routines + +sub uri_convert { # (ipp_disk,remote_disk) = uri_convert(neb_uri); + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $ff_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_convert_and_create { # (ipp_disk,remote_disk) = uri_convert_and_create(neb_uri); ipp_disk is created if it doesn't exist + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri , 1); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $ff_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { # (ipp_disk,remote_disk) = uri_to_output(neb_uri); Appends to TRANSFER and CHECK filehandles + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = &uri_convert( $neb_uri ); + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs_raw { + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + $remote_disk = $remote_raw . $ipp_disk; + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs_for_return { # (ipp_disk,remote_disk) = uri_to_outputs_for_return(neb_uri); create ipp_disk, append to RETURN and GENERATE + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = &uri_convert_and_create( $neb_uri ); + + print RETURN "$ipp_disk\n"; + print GENERATE "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { #(remote_uri) = uri_local_to_remote(local_neb_uri); + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { #(local_neb_uri) = uri_remote_to_local(remote_uri); + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} + + +sub my_die { # exit with status; my_die(message,stage_id,exit_code,exit_status); + my $msg = shift; + my $remote_id = shift; + my $stage_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and defined $stage_id and not $no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stage_id"; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_run.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_run.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_run.pl (revision 41105) @@ -0,0 +1,387 @@ +#! /usr/bin/env perl + +# this script takes a list of run components ready to be run +# (remoteComponent.state=prep_done) and generates the master run +# scripts for that set. Components which have +# (remoteComponent.state=prep_fail) are skipped + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +#use Data::Dumper; +# Look for programs we need +my $missing_tools; +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Options +my ($remote_id,$cmd_recipe,$stage,$camera,$path_base,$dbname,$verbose,$no_update); +GetOptions( + 'remote_id=s' => \$remote_id, + 'recipe=s' => \$cmd_recipe, + 'stage=s' => \$stage, + 'camera|c=s' => \$camera, + 'path_base=s' => \$path_base, + 'dbname|d=s' => \$dbname, + 'verbose' => \$verbose, + 'no_update' => \$no_update, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --stage --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($stage) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname) and + defined($dbname); + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + +my $remote_root = $remote_recipe{REMOTE_ROOT}; +my $remote_raw = "${remote_root}/tmp/"; # Directory to find raw data in. + +my $threads = 2; # How many threads are we going to use? + +my $fail_state = "prep_fail"; + +# Estimate of how long a job runs, in hours (depends on stage) +my %job_cost = (); +$job_cost{"camera"} = 1700 / 60 / 60; +$job_cost{"chip"} = 150 / 60 / 60; +$job_cost{"warp"} = 110 / 60 / 60; +$job_cost{"stack"} = 1500 / 60 / 60; +$job_cost{"staticsky"} = 2; # really? avg time of 5720s? +$job_cost{"diff"} = 300 / 60 / 60; +$job_cost{"ff"} = 300 / 60 / 60; # This is an 83%-ile point, but the tail is long. + +# This object holds how "expensive" a given job is in terms of cores on a node. +# Passed to stask to limit how many jobs run simultaneously +my %job_subscription = (); +$job_subscription{"camera"} = 1; +$job_subscription{"chip"} = 1; +$job_subscription{"warp"} = 1; +$job_subscription{"stack"} = 3; +$job_subscription{"staticsky"} = 3; +$job_subscription{"diff"} = 1; +$job_subscription{"ff"} = 1; + +my $proc_per_node = $remote_recipe{PROC_PER_NODE}; # processors per node +my $min_nodes = $remote_recipe{MIN_NODES}; # smallest allocation to ask for +my $max_nodes = $remote_recipe{MAX_NODES}; # largest allocation to ask for +my $min_time = $remote_recipe{MIN_TIME}; # shortest allocation to ask for +my $max_time = $remote_recipe{MAX_TIME}; # longest allocation to ask for + +# We need to ensure we only ever try to transfer a file once. +my %file_filter = (); + + +# Finish setup +my $ipprc = PS::IPP::Config->new( $camera ) or &my_die( "Unable to set up", $remote_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# STEP 1: Get a list of the components that make up this remoteRun +my $compData; +{ + my $command = "$remotetool -listcomponent -remote_id $remote_id -state prep_done"; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("Unable to run remotetool to determine stage parameters.", $remote_id, $error_code, $fail_state); + } + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine component information.", $remote_id, $PS_EXIT_PROG_ERROR, $fail_state); + $compData = parse_md_list($MDlist); +} + +# STEP 2: Open master output files +my $uri_command = $path_base . ".cmd"; +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_command = $ipprc->file_resolve($uri_command,1); +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my %have_transfer = (); +my %have_check = (); +my %have_config = (); +my %have_generate = (); +my %have_return = (); + +my (undef, $remote_config) = uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$remote_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate",$remote_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $PS_EXIT_SYS_ERROR, $fail_state); + +# Step 2: Iterate over all componenets in this remote run. +my $job_index = 0; +foreach my $compEntry (@$compData) { + my $line; + + my $stage_id = $compEntry->{stage_id}; + + my $in_path_base = $compEntry->{path_base}; + + my $state = $compEntry->{state}; + if ($state eq 'fail') { next; } + + my $uri_transfer = $in_path_base . ".transfer"; + my $disk_transfer= $ipprc->file_resolve($uri_transfer); + open(INPUT, "$disk_transfer"); + while ($line = ) { + unless ($have_transfer{$line}) { + $have_transfer{$line} = 1; + print TRANSFER $line; + } + } + close (INPUT); + + my $uri_check = $in_path_base . ".check"; + my $disk_check= $ipprc->file_resolve($uri_check); + open(INPUT, "$disk_check"); + while ($line = ) { + unless ($have_check{$line}) { + $have_check{$line} = 1; + print CHECK $line; + } + } + close (INPUT); + + my $uri_config = $in_path_base . ".config"; + my $disk_config= $ipprc->file_resolve($uri_config); + open(INPUT, "$disk_config"); + while ($line = ) { + unless ($have_config{$line}) { + $have_config{$line} = 1; + print CONFIG $line; + } + } + close (INPUT); + + my $uri_generate = $in_path_base . ".generate"; + my $disk_generate= $ipprc->file_resolve($uri_generate); + open(INPUT, "$disk_generate"); + while ($line = ) { + unless ($have_generate{$line}) { + $have_generate{$line} = 1; + print GENERATE $line; + } + } + close (INPUT); + + my $uri_return = $in_path_base . ".return"; + my $disk_return= $ipprc->file_resolve($uri_return); + open(INPUT, "$disk_return"); + while ($line = ) { + unless ($have_return{$line}) { + $have_return{$line} = 1; + print RETURN $line; + } + } + close (INPUT); + + if (($job_index % 100) == 0) { + print CONFIG "top -b -n 1\n"; + } + + $job_index += $compEntry->{jobs}; +} + +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +# Construct the moab command last, so we can use the job_index counter to estimate resources. Somehow. +my $proc_need = $job_index * $threads; # how many total processors do we need? +my $node_need = $proc_need / $proc_per_node; # this equals how many nodes? +my $time_need = $job_index * $job_cost{$stage}; # How many seconds will this take? + +my $fill_factor = 0.8; # This is the factor of how much of the time allocation we'd like to fill +my ($time_req,$node_req); +if ($node_need * $job_cost{$stage} < $fill_factor * $min_nodes * $min_time) { + $time_req = $min_time; + $node_req = $min_nodes; +} +elsif ($node_need * $job_cost{$stage} > $fill_factor * $max_nodes * $max_time) { + $time_req = $max_time; + $node_req = $max_nodes; + print STDERR "You've requested the construction of a bundle that appears to need $node_need nodes and $job_cost{$stage} time per job. This exceeds the max limits ($max_nodes, $max_time). Using those max values instead. Good luck.\n"; +} +else { + $time_req = int(($node_need * $job_cost{$stage}) / ($fill_factor * $max_nodes)) + 1; + $node_req = int(($node_need * $job_cost{$stage}) / ($fill_factor * $time_req)) + 1; +} + +# Most jobs only take 1 core, but ensure that we split them appropriately +$node_req *= $job_subscription{$stage}; + +if (($stage eq "stack")||($stage eq "staticsky")) { + $time_req += 2; +} else { + $time_req += 1; # Safety addition. +} + +open(COMMAND, ">$disk_command") || &my_die("Couldn't open file? $disk_command", $remote_id, $PS_EXIT_SYS_ERROR, $fail_state); +print COMMAND "#!/bin/tcsh\n"; +print COMMAND "##### Moab controll lines\n"; +if ($remote_recipe{SCHEDULER} eq 'MOAB') { + print COMMAND "#MSUB -l nodes=${node_req}:ppn=${proc_per_node},walltime=${time_req}:00:00\n"; ## CHECK RESOURCES + print COMMAND "#MSUB -j oe\n"; + print COMMAND "#MSUB -V\n"; + print COMMAND "#MSUB -o ${remote_root}/stask_logs/${stage}.${remote_id}.out\n"; +} +elsif ($remote_recipe{SCHEDULER} eq 'SLURM') { + print COMMAND "###### sbatch control lines\n"; + print COMMAND "#SBATCH --time ${time_req}:00:00\n"; + print COMMAND "#SBATCH --nodes ${node_req}\n"; + print COMMAND "#SBATCH --open-mode=append\n"; + print COMMAND "#SBATCH --export=ALL\n"; + print COMMAND "#SBATCH --exclusive\n"; + print COMMAND "#SBATCH -o ${remote_root}/stask_logs/${stage}.${remote_id}.out\n"; +} +else { + &my_die("No scheduler defined", $remote_id, 0, 'fail_state'); +} + +print COMMAND "date\n"; +print COMMAND 'srun -n $SLURM_JOB_NUM_NODES -m cyclic -l /bin/hostname | sort -n | awk \'{printf "%s\n", $2}\' > hosts.${SLURM_JOB_ID}' . "\n"; +if (($stage eq "stack")||($stage eq "staticsky")) { + print COMMAND "${remote_root}/stask_stack.py $remote_config " . 'hosts.${SLURM_JOB_ID} ' . $job_subscription{$stage} . "\n"; +} +else { + print COMMAND "${remote_root}/stask_chip.py $remote_config " . 'hosts.${SLURM_JOB_ID} ' . $job_subscription{$stage} . "\n"; +} +print COMMAND "date\n"; +close(COMMAND); + +## We're done here. The execution and handling are done elsewhere. +# Quick review: +# new -> pending -> run -> full +# auth +unless($no_update) { + my $command = "remotetool -updaterun -remote_id $remote_id "; + $command .= " -set_state pending "; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} + +exit (0); + +sub uri_convert { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub my_die { + my $msg = shift; + my $remote_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and not $no_update) { + my $command = "remotetool -updaterun -remote_id $remote_id"; + $command .= " -fault $exit_code " if defined $exit_code; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_stack.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_stack.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_stack.pl (revision 41105) @@ -0,0 +1,392 @@ +#! /usr/bin/env perl + +# generate the input & output files lists and commands for a single stackRun + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($remote_id,$stack_id,$camera,$dbname,$verbose,$path_base,$no_update,$cmd_recipe); +GetOptions( + 'remote_id=s' => \$remote_id, + 'stack_id=s' => \$stack_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --stack_id --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($stack_id) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname); + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + +# my $remote_root = '/lustre/scratch1/turquoise/watersc1/ps1/'; # Far side destination base location +my $remote_root = $remote_recipe{REMOTE_ROOT}; # Far side destination base location +my $remote_hostname = $remote_recipe{REMOTE_HOSTNAME}; # Name of the remote node. +my $threads_req = 4; # How many threads are we going to use? +my $have_warps = $remote_recipe{TRANSFER_WARP_IMAGES}; # Do we have a copy of the warp if we don't find one there? + +my $fail_state = "prep_fail"; + + +my $ipprc = PS::IPP::Config->new( $camera ) or &my_die( "Unable to set up", $remote_id, $stack_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my @return_component_list = ("DBINFO.EXP", "PPSTACK.UNCONV","PPSTACK.UNCONV.MASK","PPSTACK.UNCONV.VARIANCE", + "PPSTACK.UNCONV.EXP","PPSTACK.UNCONV.EXPWT","PPSTACK.UNCONV.EXPNUM", + "PSPHOT.OUT.CMF.MEF", # Use this output product to get the one that exists. + "LOG.EXP", "PSASTRO.STATS", + "PPSTACK.CONFIG","PPSTACK.TARGET.PSF","PSPHOT.STACK.PSF.SAVE"); +#,"PPSTACK.CONV.KERNEL"); + +# STEP 0: Open output files +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my (undef, $remote_config) = &uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate",$remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); + +my $job_index = 0; + +# STEP 1: Get exposure level information from the stackRun we're working from. +my ($reduction, $workdir, $tess_id, $skycell_id); +{ + my $command = "$stacktool -tosum -stack_id $stack_id"; + $command .= " -dbname $dbname " if defined($dbname); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run stacktool -tosum ", $remote_id, $stack_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine stack component information.", $remote_id, $stack_id, $PS_EXIT_PROG_ERROR, $fail_state); + my $metadata = parse_md_list($MDlist); + + my $stack = $metadata->[0]; + + $reduction = $stack->{reduction}; + $reduction = 'DEFAULT' unless defined($reduction); + $workdir = $stack->{workdir}; + $tess_id = $stack->{tess_id}; + $skycell_id= $stack->{skycell_id}; +} +my $ipp_outroot = "${workdir}/${tess_id}/${skycell_id}/${tess_id}.${skycell_id}.stk.${stack_id}"; +my $remote_outroot = &uri_local_to_remote($ipp_outroot); +my $remote_outdir = &uri_local_to_remote("${workdir}/${tess_id}/${skycell_id}"); + +# STEP 2: Get the list of input warps +my ($warpData); +{ + # This actually returns all the individual stack/skyfiles that comprise this run. Because consistency. + my $command = "$stacktool -inputskyfile -stack_id $stack_id "; + $command .= " -dbname $dbname " if defined($dbname); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run stacktool -inputskyfile ", $remote_id, $stack_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine stack component information.", $remote_id, $stack_id, $PS_EXIT_PROG_ERROR, $fail_state); + $warpData = parse_md_list($MDlist); +} + +# STEP 3: Iterate over the sub-components +{ + # Generate a file mapping the symbolic and "disk" representations of each needed file. + my $uri_compmap = "${ipp_outroot}.compmap"; + my $component_map = $ipprc->file_resolve($uri_compmap,1); + my ($ipp_compmap, $remote_compmap) = &uri_to_outputs($component_map); + open(COMPMAP,">$ipp_compmap") || &my_die("Couldn't open file? $ipp_compmap", $remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); + + # Loop over all needed components for this stack. + my $warp_path_base_string = ""; + foreach my $warpEntry ( @{ $warpData } ) { + my $warp_path_base = $warpEntry->{path_base}; + my $remote_path_base = &uri_local_to_remote($warp_path_base); + $warp_path_base_string .= " $remote_path_base "; + + if ($verbose) { print STDERR "$warp_path_base_string\n"; } + + # Append file names to transfer lists so we can recover if warps are deleted. + my $remote_file; + my $ipp_disk; + # ${remote_root}/tmp/${ipp_disk} + + if ($have_warps) { # Check to see if we have a copy, because if we do, then we can send it over if it's missing. + (undef,$remote_file) = &uri_to_outputs($warp_path_base . ".fits"); + ($ipp_disk,undef) = &uri_convert($warp_path_base . ".fits"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + + (undef,$remote_file) = &uri_to_outputs($warp_path_base . ".wt.fits"); + ($ipp_disk,undef) = &uri_convert($warp_path_base . ".wt.fits"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + + (undef,$remote_file) = &uri_to_outputs($warp_path_base . ".mask.fits"); + ($ipp_disk,undef) = &uri_convert($warp_path_base . ".mask.fits"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + + (undef,$remote_file) = &uri_to_outputs($warp_path_base . ".cmf"); + ($ipp_disk,undef) = &uri_convert($warp_path_base . ".cmf"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + + (undef,$remote_file) = &uri_to_outputs($warp_path_base . ".psf"); + ($ipp_disk,undef) = &uri_convert($warp_path_base . ".psf"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + + } + else { + $remote_file = &uri_local_to_remote($warp_path_base . ".fits"); + print COMPMAP "$remote_file $remote_file\n"; # No other option, really. + + $remote_file = &uri_local_to_remote($warp_path_base . ".wt.fits"); + print COMPMAP "$remote_file $remote_file\n"; # No other option, really. + + $remote_file = &uri_local_to_remote($warp_path_base . ".mask.fits"); + print COMPMAP "$remote_file $remote_file\n"; # No other option, really. + + $remote_file = &uri_local_to_remote($warp_path_base . ".cmf"); + print COMPMAP "$remote_file $remote_file\n"; # No other option, really. + + $remote_file = &uri_local_to_remote($warp_path_base . ".psf"); + print COMPMAP "$remote_file $remote_file\n"; # No other option, really. + + } + } + + close(COMPMAP); + + my $mk_mdc_command = "mkdir -p $remote_outdir && sc_mk_stack_mdc.pl --remote_root ${remote_root} --compmap ${remote_root}/tmp/${component_map} $warp_path_base_string > ${remote_outroot}.in.mdc"; + my $recipe_ppstack = $ipprc->reduction($reduction, 'STACK_PPSTACK'); # Recipe to use + my $ppstack_command = " ppStack -input ${remote_outroot}.in.mdc "; + $ppstack_command .= " ${remote_outroot} -stats ${remote_outroot}.stats "; + $ppstack_command .= " -recipe PPSTACK $recipe_ppstack "; + $ppstack_command .= " -recipe PPSUB STACK_1DG -recipe PSPHOT STACK -recipe PPSTATS STACKSTATS "; + $ppstack_command .= " -stack-type DEEP_STACK -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE "; + $ppstack_command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF "; + $ppstack_command .= " -F SOURCE.PLOT.MOMENTS SOURCE.PLOT.SKY.MOMENTS -F SOURCE.PLOT.PSFMODEL SOURCE.PLOT.SKY.PSFMODEL "; + $ppstack_command .= " -F SOURCE.PLOT.APRESID SOURCE.PLOT.SKY.APRESID -R PPSTACK.OUTPUT FITS.TYPE COMP_STACK "; + $ppstack_command .= " -R PPSTACK.OUTPUT.VARIANCE FITS.TYPE COMP_STACK -R PPSTACK.UNCONV FITS.TYPE COMP_STACK "; + $ppstack_command .= " -R PPSTACK.UNCONV.VARIANCE FITS.TYPE COMP_STACK"; + $ppstack_command .= " -tracedest ${remote_outroot}.trace -log ${remote_outroot}.log "; + $ppstack_command .= " -threads $threads_req "; + $ppstack_command .= " -dumpconfig ${remote_outroot}.mdc "; + $ppstack_command .= " -stack_id $stack_id -skycell_id $skycell_id -tess_id $tess_id >& ${remote_outroot}.log2 "; + + my $post_cmd_echo = " echo -n \"stacktool -addsumskyfile -stack_id $stack_id "; + $post_cmd_echo .= " -path_base $ipp_outroot -uri UNKNOWN "; + $post_cmd_echo .= " -dbname $dbname " if defined $dbname; + $post_cmd_echo .= " -hostname $remote_hostname -dtime_script 0 \" > ${remote_outroot}.dbinfo "; + + my $post_cmd_SfM = " ppStatsFromMetadata ${remote_outroot}.stats - STACK_SKYCELL >> ${remote_outroot}.dbinfo "; + + print CONFIG "${mk_mdc_command} && ${ppstack_command} && ${post_cmd_echo} && ${post_cmd_SfM} "; + $job_index++; + + # Determine which output files need to be returned + foreach my $component(@return_component_list) { + my $filename = $ipprc->filename($component,$ipp_outroot); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + print CONFIG "\n"; +} +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +unless($no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stack_id "; + $command .= " -set_jobs $job_index"; + $command .= " -set_path_base $path_base"; + $command .= " -set_state prep_done"; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} + +## Common SC routines + +# KEEP +sub uri_convert { # (ipp_disk,remote_disk) = uri_convert(neb_uri); + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_convert_and_create { # (ipp_disk,remote_disk) = uri_convert_and_create(neb_uri); ipp_disk is created if it doesn't exist + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri , 1); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $stack_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_to_outputs { # (ipp_disk,remote_disk) = uri_to_output(neb_uri); Appends to TRANSFER and CHECK filehandles + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_to_outputs_for_return { # (ipp_disk,remote_disk) = uri_to_outputs_for_return(neb_uri); create ipp_disk, append to RETURN and GENERATE + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert_and_create( $neb_uri ); + + print RETURN "$ipp_disk\n"; + print GENERATE "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_local_to_remote { #(remote_uri) = uri_local_to_remote(local_neb_uri); + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub my_die { # exit with status; my_die(message,stage_id,exit_code,exit_status); + my $msg = shift; + my $remote_id = shift; + my $stage_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and defined $stage_id and not $no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stage_id"; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_staticsky.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_staticsky.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_staticsky.pl (revision 41105) @@ -0,0 +1,387 @@ +#! /usr/bin/env perl + +# generate the input & output files lists and commands for a single staticskyRun. + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $staticskytool= can_run('staticskytool') or (warn "Can't find staticskytool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($remote_id,$sky_id,$camera,$dbname,$verbose,$path_base,$no_update,$cmd_recipe); +GetOptions( + 'remote_id=s' => \$remote_id, + 'sky_id=s' => \$sky_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --sky_id --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($sky_id) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname); + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + + +my $remote_root = $remote_recipe{REMOTE_ROOT}; # Far side destination base location +my $remote_hostname = $remote_recipe{REMOTE_HOSTNAME}; # Name of the remote node. +my $threads_req = 4; # How many threads are we going to use? + +my $fail_state = "prep_fail"; + + +my $ipprc = PS::IPP::Config->new( $camera ) or &my_die( "Unable to set up", $remote_id, $sky_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my @return_component_list = ("LOG.EXP","PSPHOT.STACK.CONFIG","DBINFO.EXP"); + + # "PSPHOT.CHISQ.IMAGE","PSPHOT.CHISQ.MASK","PSPHOT.CHISQ.VARIANCE"); + +my @return_component_list_per_input = (#"PSPHOT.STACK.OUTPUT.IMAGE","PSPHOT.STACK.OUTPUT.MASK","PSPHOT.STACK.OUTPUT.VARIANCE","PSPHOT.STACK.OUTPUT"); + "PSPHOT.STACK.OUTPUT", + "PSPHOT.STACK.PSF.SAVE", + "PSPHOT.STACK.BACKMDL"); + +# STEP 0: Open output files +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my (undef, $remote_config) = &uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate",$remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); + +my $job_index = 0; + +# STEP 1: Get exposure level information from the stackRun we're working from. +my ($reduction, $workdir, $tess_id, $skycell_id); +{ + my $command = "$staticskytool -todo -sky_id $sky_id"; + $command .= " -dbname $dbname " if defined($dbname); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run staticskytool -inputs ", $remote_id, $sky_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine stack component information.", $remote_id, $sky_id, $PS_EXIT_PROG_ERROR, $fail_state); + my $metadata = parse_md_list($MDlist); + + my $stack = $metadata->[0]; + + $reduction = $stack->{reduction}; + $reduction = 'DEFAULT' unless defined($reduction); + $workdir = $stack->{workdir}; + $tess_id = $stack->{tess_id}; + $skycell_id= $stack->{skycell_id}; +} +my $ipp_outroot = "${workdir}/${tess_id}/${skycell_id}/${tess_id}.${skycell_id}.sky.${sky_id}"; +my $remote_outroot = &uri_local_to_remote($ipp_outroot); +my $remote_outdir = &uri_local_to_remote("${workdir}/${tess_id}/${skycell_id}"); + +# STEP 2: Get the list of inputs +my ($inputData); +{ + # This actually returns all the individual stack/skyfiles that comprise this run. Because consistency. + my $command = "$staticskytool -inputs -sky_id $sky_id "; + $command .= " -dbname $dbname " if defined($dbname); + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run stacktool -inputskyfile ", $remote_id, $sky_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine stack component information.", $remote_id, $sky_id, $PS_EXIT_PROG_ERROR, $fail_state); + $inputData = parse_md_list($MDlist); +} + +# STEP 3: Iterate over the sub-components +{ + # Generate a file mapping the symbolic and "disk" representations of each needed file. + my $uri_compmap = "${ipp_outroot}.compmap"; + my $component_map = $ipprc->file_resolve($uri_compmap,1); + my ($ipp_compmap, $remote_compmap) = &uri_to_outputs($component_map); + open(COMPMAP,">$ipp_compmap") || &my_die("Couldn't open file? $ipp_compmap", $remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); + + # Loop over all needed components for this stack. + my $nInputs = 0; + my $input_path_base_string = ""; + foreach my $inputEntry ( @{ $inputData } ) { + my $input_stack_id = $inputEntry->{stack_id}; + + my $input_path_base = $inputEntry->{path_base}; + my $remote_path_base = &uri_local_to_remote($input_path_base); + $input_path_base_string .= " $remote_path_base "; + $input_path_base_string .= " $input_stack_id "; + if ($verbose) { print STDERR "$input_path_base_string\n"; } + + # Append file names to transfer lists so we can recover if inputs are deleted. + my $remote_file; + my $ipp_disk; + # ${remote_root}/tmp/${ipp_disk} + (undef,$remote_file) = &uri_to_outputs($input_path_base . ".unconv.fits"); + ($ipp_disk,undef) = &uri_convert($input_path_base . ".unconv.fits"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + (undef,$remote_file) = &uri_to_outputs($input_path_base . ".unconv.wt.fits"); + ($ipp_disk,undef) = &uri_convert($input_path_base . ".unconv.wt.fits"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + (undef,$remote_file) = &uri_to_outputs($input_path_base . ".unconv.mask.fits"); + ($ipp_disk,undef) = &uri_convert($input_path_base . ".unconv.mask.fits"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + (undef,$remote_file) = &uri_to_outputs($input_path_base . ".unconv.num.fits"); + ($ipp_disk,undef) = &uri_convert($input_path_base . ".unconv.num.fits"); + print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; +# (undef,$remote_file) = &uri_to_outputs($input_path_base . ".cmf"); +# ($ipp_disk,undef) = &uri_convert($input_path_base . ".cmf"); +# print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; +# (undef,$remote_file) = &uri_to_outputs($input_path_base . ".psf"); +# ($ipp_disk,undef) = &uri_convert($input_path_base . ".psf"); +# print COMPMAP "$remote_file ${remote_root}/tmp/${ipp_disk}\n"; + + $nInputs++; + } + + close(COMPMAP); + + my $mk_mdc_command = "mkdir -p $remote_outdir && sc_mk_staticsky_mdc.pl --remote_root ${remote_root} --compmap ${remote_root}/tmp/${component_map} $input_path_base_string > ${remote_outroot}.in.mdc"; + my $recipe_psphot = $ipprc->reduction($reduction, 'STACKPHOT_PSPHOT'); + my $recipe_ppsub = $ipprc->reduction($reduction, 'STACKPHOT_PPSUB'); + my $recipe_ppstack= $ipprc->reduction($reduction, 'STACKPHOT_PPSTACK'); # Recipe to use + + my $pps_command = " psphotStack -input ${remote_outroot}.in.mdc "; + $pps_command .= " ${remote_outroot} "; + $pps_command .= " -recipe PSPHOT $recipe_psphot "; + $pps_command .= " -recipe PPSUB $recipe_ppsub "; + $pps_command .= " -recipe PPSTACK $recipe_ppstack "; + $pps_command .= " -tracedest ${remote_outroot}.trace -log ${remote_outroot}.log "; + $pps_command .= " -threads $threads_req "; + $pps_command .= " -dumpconfig ${remote_outroot}.psphotStack.mdc >& ${remote_outroot}.log2 "; + + my $post_cmd_echo = " echo -n \"staticskytool -addresult -sky_id $sky_id "; + $post_cmd_echo .= " -path_base $ipp_outroot -num_inputs $nInputs "; + $post_cmd_echo .= " -dbname $dbname " if defined $dbname; + $post_cmd_echo .= " -hostname $remote_hostname -dtime_script 0 \" > ${remote_outroot}.dbinfo "; + +# CZW: 2014-09-26 We currently do not save any information into the database here, so I'm leaving the dummy from stack. +# my $post_cmd_SfM = " ppStatsFromMetadata ${remote_outroot}.stats - STACK_SKYCELL >> ${remote_outroot}.dbinfo "; +# print CONFIG "${mk_mdc_command} && ${pps_command} && ${post_cmd_echo} && ${post_cmd_SfM} "; + + print CONFIG "${mk_mdc_command} && ${pps_command} && ${post_cmd_echo} "; + $job_index++; + + # Determine which output files need to be returned + foreach my $component(@return_component_list) { + my $filename = $ipprc->filename($component,$ipp_outroot); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + # But this creates outputs for each input stack, so iterate over those as well. + foreach my $inputEntry (@{ $inputData }) { + my $stack_id = $inputEntry->{stack_id}; + foreach my $component (@return_component_list_per_input) { + my $filename = $ipprc->filename($component,$ipp_outroot,$stack_id); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename ); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + } + + print CONFIG "\n"; +} +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +unless($no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $sky_id "; + $command .= " -set_jobs $job_index"; + $command .= " -set_path_base $path_base"; + $command .= " -set_state prep_done"; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} + +## Common SC routines + +# KEEP +sub uri_convert { # (ipp_disk,remote_disk) = uri_convert(neb_uri); + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_convert_and_create { # (ipp_disk,remote_disk) = uri_convert_and_create(neb_uri); ipp_disk is created if it doesn't exist + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri , 1); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $sky_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_to_outputs { # (ipp_disk,remote_disk) = uri_to_output(neb_uri); Appends to TRANSFER and CHECK filehandles + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_to_outputs_for_return { # (ipp_disk,remote_disk) = uri_to_outputs_for_return(neb_uri); create ipp_disk, append to RETURN and GENERATE + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert_and_create( $neb_uri ); + + print RETURN "$ipp_disk\n"; + print GENERATE "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +# KEEP +sub uri_local_to_remote { #(remote_uri) = uri_local_to_remote(local_neb_uri); + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub my_die { # exit with status; my_die(message,stage_id,exit_code,exit_status); + my $msg = shift; + my $remote_id = shift; + my $stage_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and defined $stage_id and not $no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stage_id"; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_warp.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_warp.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_prepare_warp.pl (revision 41105) @@ -0,0 +1,370 @@ +#! /usr/bin/env perl + +# generate the input & output files lists and commands for a single warpRun + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; +use File::Basename; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($remote_id,$warp_id,$camera,$dbname,$verbose,$path_base,$no_update,$cmd_recipe); +GetOptions( + 'remote_id=s' => \$remote_id, + 'warp_id=s' => \$warp_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id -warp_id --camera --dbname --path_base --recipe", -exitval => 3) unless + defined($remote_id) and + defined($warp_id) and + defined($camera) and + defined($path_base) and + defined($cmd_recipe) and + defined($dbname); + + +# Hard coded values +# my $remote_root = '/lustre/scratch1/turquoise/watersc1/ps1/'; # Far side destination base location +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); + +} + +my $remote_root = $remote_recipe{REMOTE_ROOT}; +my $hostname = $remote_recipe{REMOTE_HOSTNAME}; +my $have_warps = $remote_recipe{TRANSFER_WARP_IMAGES}; +my $threads_req = 4; # How many threads are we going to use? + +my $fail_state = "prep_fail"; + + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $remote_id, $warp_id, $PS_EXIT_CONFIG_ERROR, $fail_state); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +my @return_component_list = ("DBINFO.EXP", "PSWARP.CONFIG", "PSWARP.OUTPUT.SOURCES","PSPHOT.PSF.SKY.SAVE","LOG.EXP"); +if ($have_warps) { + push @return_component_list, ("PSWARP.OUTPUT", "PSWARP.OUTPUT.MASK", "PSWARP.OUTPUT.VARIANCE"); +} + +# STEP 0: Open output files +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); +my $disk_generate= $ipprc->file_resolve($uri_generate,1); +my $disk_return = $ipprc->file_resolve($uri_return,1); + +my (undef, $remote_config) = &uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check", $remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config", $remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(GENERATE, ">$disk_generate") || &my_die("Couldn't open file? $disk_generate",$remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); +open(RETURN, ">$disk_return") || &my_die("Couldn't open file? $disk_return", $remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); + +my $job_index = 0; + +# STEP 1: Get exposure level information from the warpRun we're working from. +my ($warpData); +{ + # This actually returns all the individual warp/skyfiles that comprise this run. Because consistency. + my $command = "$warptool -towarped -warp_id $warp_id "; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run warptool -pendingimfile ", $remote_id, $warp_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine warp component information.", $remote_id, $warp_id, $PS_EXIT_PROG_ERROR, $fail_state); + $warpData = parse_md_list($MDlist); +} + +# STEP 2: Iterate over the sub-components +{ + foreach my $warpEntry ( @{ $warpData } ) { + my $workdir = $warpEntry->{workdir}; + my $exp_tag = $warpEntry->{exp_tag}; + my $skycell_id = $warpEntry->{skycell_id}; + my $tess_id = $warpEntry->{tess_id}; + + my $reduction = $warpEntry->{reduction}; + $reduction = 'DEFAULT' unless defined $warpEntry->{reduction}; + + my $recipe_pswarp = $ipprc->reduction($reduction, 'WARP_PSWARP'); # Recipe to use + if ($recipe_pswarp eq "") { + &my_die("Unable to determine PSWARP recipe for $reduction", $remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + my $ipp_outroot = "${workdir}/${exp_tag}/${exp_tag}.wrp.${warp_id}.${skycell_id}"; + print "$ipp_outroot\n"; + my $remote_outroot = &uri_local_to_remote($ipp_outroot); + + my $command = "$warptool -scmap -warp_id $warp_id -skycell_id ${skycell_id}"; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run warptool -pendingimfile: $command ", $remote_id, $warp_id, $error_code, $fail_state); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine warp component information.", $remote_id, $warp_id, $PS_EXIT_PROG_ERROR, $fail_state); + my $inData = parse_md_list($MDlist); + + my $pre_cmd_ims = "ls -1 "; + my $pre_cmd_masks= "ls -1 "; + my $pre_cmd_vars = "ls -1 "; + my $pre_cmd_astrom = ""; + + foreach my $imfile (@{ $inData }) { + my $image = $ipprc->filename("PPIMAGE.CHIP", $imfile->{chip_path_base}, $imfile->{class_id}); + my $mask = $ipprc->filename("PSASTRO.OUTPUT.MASK", $imfile->{cam_path_base}, $imfile->{class_id}); + my $var = $ipprc->filename("PPIMAGE.CHIP.VARIANCE", $imfile->{chip_path_base}, $imfile->{class_id}); + + my $astrom= $ipprc->filename("PSASTRO.OUTPUT", $imfile->{cam_path_base}); + + my $remote_image = &uri_local_to_remote($image); + my $remote_mask = &uri_local_to_remote($mask); + my $remote_var = &uri_local_to_remote($var); + my $remote_astrom= &uri_local_to_remote($astrom); + + $pre_cmd_ims .= " $remote_image "; + $pre_cmd_masks .= " $remote_mask "; + $pre_cmd_vars .= " $remote_var "; + $pre_cmd_astrom = "echo $remote_astrom > ${remote_outroot}.astrom "; + } + $pre_cmd_ims .= " > ${remote_outroot}.imlist "; + $pre_cmd_masks .= " > ${remote_outroot}.masklist "; + $pre_cmd_vars .= " > ${remote_outroot}.varlist "; + + my $skycell_command = " dvoImageExtract -D CATDIR /turquoise/usr/projects/ps1/watersc1/tess/${tess_id} $skycell_id -o ${remote_outroot}.skyfile "; + + my $pswarp_command = " pswarp -list ${remote_outroot}.imlist "; + $pswarp_command .= " -masklist ${remote_outroot}.masklist -variancelist ${remote_outroot}.varlist "; + $pswarp_command .= " -astromlist ${remote_outroot}.astrom "; + $pswarp_command .= " ${remote_outroot} ${remote_outroot}.skyfile "; + $pswarp_command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE "; + $pswarp_command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF "; + $pswarp_command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF "; + $pswarp_command .= " -F SOURCE.PLOT.MOMENTS SOURCE.PLOT.SKY.MOMENTS "; + $pswarp_command .= " -F SOURCE.PLOT.PSFMODEL SOURCE.PLOT.SKY.PSFMODEL "; + $pswarp_command .= " -F SOURCE.PLOT.APRESID SOURCE.PLOT.SKY.APRESID "; + $pswarp_command .= " -recipe PSWARP $recipe_pswarp "; + $pswarp_command .= " -tracedest ${remote_outroot}.trace -log ${remote_outroot}.log "; + $pswarp_command .= " -threads $threads_req "; # -image_id ${image_id} -source_id ${source_id} "; + $pswarp_command .= " -recipe PPSTATS WARPSTATS "; + $pswarp_command .= " -dumpconfig ${remote_outroot}.pswarp.mdc -stats ${remote_outroot}.stats "; + +# print "$pswarp_command \n"; + + my $post_cmd_echo = " echo -n \"warptool -addwarped -warp_id $warp_id -skycell_id $skycell_id -tess_id $tess_id "; + $post_cmd_echo .= " -dbname $dbname " if defined $dbname; + $post_cmd_echo .= " -uri ${ipp_outroot}.fits "; + $post_cmd_echo .= " -path_base $ipp_outroot -hostname $remote_hostname -dtime_script 0 \" > ${remote_outroot}.dbinfo "; + + my $post_cmd_SfM = " ppStatsFromMetadata ${remote_outroot}.stats - WARP_SKYCELL >> ${remote_outroot}.dbinfo "; + + print CONFIG "${pre_cmd_ims} && ${pre_cmd_masks} && ${pre_cmd_vars} && ${pre_cmd_astrom} && ${skycell_command} && ${pswarp_command} && ${post_cmd_echo} && ${post_cmd_SfM} "; + $job_index++; + + # Determine which output files need to be returned + foreach my $component(@return_component_list) { + my $filename = $ipprc->filename($component,$ipp_outroot,$skycell_id); + my ($ipp_disk, $remote_disk) = &uri_to_outputs_for_return( $filename); + my $remote_outroot_dir = dirname($ipp_disk); + print CONFIG " && mkdir -p ${remote_root}/tmp/${remote_outroot_dir} && ln -sf $remote_disk ${remote_root}/tmp/${ipp_disk} && touch $remote_disk "; + } + print CONFIG "\n"; +# die(); + } +} +close(CONFIG); +close(TRANSFER); +close(CHECK); +close(RETURN); +close(GENERATE); + +unless($no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $warp_id "; + $command .= " -set_jobs $job_index"; + $command .= " -set_path_base $path_base"; + $command .= " -set_state prep_done"; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} +exit (0); + +## Common SC routines + +sub uri_convert { # (ipp_disk,remote_disk) = uri_convert(neb_uri); + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_convert_and_create { # (ipp_disk,remote_disk) = uri_convert_and_create(neb_uri); ipp_disk is created if it doesn't exist + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri , 1); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die( "Unable to generate file for $neb_uri ", $remote_id, $warp_id, $PS_EXIT_SYS_ERROR, $fail_state); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { # (ipp_disk,remote_disk) = uri_to_output(neb_uri); Appends to TRANSFER and CHECK filehandles + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = &uri_convert( $neb_uri ); + + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs_for_return { # (ipp_disk,remote_disk) = uri_to_outputs_for_return(neb_uri); create ipp_disk, append to RETURN and GENERATE + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = &uri_convert_and_create( $neb_uri ); + + print RETURN "$ipp_disk\n"; + print GENERATE "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { #(remote_uri) = uri_local_to_remote(local_neb_uri); + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { #(local_neb_uri) = uri_remote_to_local(remote_uri); + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} + + +sub my_die { # exit with status; my_die(message,stage_id,exit_code,exit_status); + my $msg = shift; + my $remote_id = shift; + my $stage_id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $remote_id and defined $stage_id and not $no_update) { + my $command = "remotetool -updatecomponent -remote_id $remote_id -stage_id $stage_id"; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_remote_exec.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_remote_exec.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_remote_exec.pl (revision 41105) @@ -0,0 +1,328 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use File::Basename; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# tools +my $missing_tools; +my $ssh = can_run('ssh') or (warn "Can't find ssh" and $missing_tools = 1); +my $scp = can_run('scp') or (warn "Can't find scp" and $missing_tools = 1); +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Options +my ($remote_id,$job_id,$path_base,$dbname,$verbose,$no_update,$camera,$cmd_recipe); +$verbose = 0; +GetOptions( + 'remote_id=s' => \$remote_id, + 'path_base=s' => \$path_base, + 'camera=s' => \$camera, + 'dbname=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'verbose' => \$verbose, + 'no_update' => \$no_update, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --path_base --recipe", -exitval => 3) unless + defined($path_base) and + defined($camera) and + defined($cmd_recipe) and + defined($dbname) and + defined($remote_id); + +# Hard coded values +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + +# Hard coded values +my $DMZ_HOST = $remote_recipe{DMZ_HOST}; +my @SEC_HOSTS = (); +my $SEC_HOST = ''; + +if (defined($remote_recipe{SEC_HOST})) { + @SEC_HOSTS = @{ $remote_recipe{SEC_HOST} }; + if ($#SEC_HOSTS != -1) { + + $SEC_HOST = $SEC_HOSTS[int(rand(@SEC_HOSTS))]; + } + else { + $SEC_HOST = ''; + } +} +my $IPP_PATH = $remote_recipe{IPP_PATH}; +my $remote_root = $remote_recipe{REMOTE_ROOT}; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $remote_id); +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Phase 1: See if we can actually do anything. +# If the link is down, there's no benefit in trying to do anything else. +&check_ssh_connection(); + +print "passed authentication challenge.\n"; + +# Phase 1.5: Grab the information about this run; +my $rt_cmd = "$remotetool -listrun -remote_id $remote_id "; +$rt_cmd .= " -dbname $dbname " if defined($dbname); +my ( $rt_success, $rt_error_code, $rt_full_buf, $rt_stdout_buf, $rt_stderr_buf ) = + run(command => $rt_cmd, verbose => $verbose); +unless ($rt_success) { + $rt_error_code = (($rt_error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run remotetool to determine remote run status", $remote_id, $rt_error_code); +} +my $rrData = $mdcParser->parse(join "", @$rt_stdout_buf) or + &my_die("Unable to run remotetool to determine remote run status", $remote_id, $rt_error_code); +my $rrData2 = parse_md_list($rrData); +my $runData = ${ $rrData2 }[0]; # There should be only one + +my ($remote_path) = &uri_local_to_remote($path_base); +print "REMOTE PATH: $remote_path\n"; + +# Phase 2: Ensure files are in place: +# Copy command files +my @files = (); + +my $uri_command = $path_base . ".cmd"; +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; +my $uri_generate= $path_base . ".generate"; +my $uri_return = $path_base . ".return"; + +my $disk_command = $ipprc->file_resolve($uri_command); +my $disk_transfer= $ipprc->file_resolve($uri_transfer); +my $disk_check = $ipprc->file_resolve($uri_check); +my $disk_config = $ipprc->file_resolve($uri_config); +my $disk_generate= $ipprc->file_resolve($uri_generate); +my $disk_return = $ipprc->file_resolve($uri_return); + +&scp_put($disk_command, &uri_local_to_remote($uri_command)); +&scp_put($disk_transfer, &uri_local_to_remote($uri_transfer)); +&scp_put($disk_check, &uri_local_to_remote($uri_check)); +&scp_put($disk_config, &uri_local_to_remote($uri_config)); +&scp_put($disk_generate, &uri_local_to_remote($uri_generate)); +&scp_put($disk_return, &uri_local_to_remote($uri_return)); + +my $ssh_check_stdout = &ssh_exec_command("${remote_root}/sc_transfer_tool.pl --input $remote_path --fetch"); + +# We no longer need to parse this output, as it retrieves files itself. +foreach my $l (split /\n/, (join '', @$ssh_check_stdout)) { + print "$l\n"; +} + +# Run real command +my (undef,$remote_command) = &uri_convert($uri_command); +my $ssh_exec_stdout; + +if ($remote_recipe{SCHEDULER} eq 'MOAB') { + $ssh_exec_stdout = &ssh_exec_command("msub -V $remote_command"); +} +elsif ($remote_recipe{SCHEDULER} eq 'SLURM') { + $ssh_exec_stdout = &ssh_exec_command("sbatch $remote_command"); +} +else { + &my_die("No scheduler defined", $remote_id, 0, 'pending'); +} +if ($#{ $ssh_exec_stdout } != -1) { # Parse the output + my $line = ${ $ssh_exec_stdout }[0]; + chomp($line); + my @line_split = split /\s+/, $line; + $job_id = $line_split[-1]; + $job_id =~ s/\s+//g; +} + +unless(defined($job_id)) { # If we don't have a job_id from this command, it didn't run correctly. + &my_die("No job_id returned. Sorry.", $remote_id, $PS_EXIT_PROG_ERROR, "exec_fail"); +} + +# Notify the database that this entry is currently running. +&my_die("Finished", $remote_id, 0, "run", $job_id); + +# END PROGRAM + +sub check_ssh_connection { + my $cmd = "$ssh -O check $DMZ_HOST"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Authorization check failed.", $remote_id, 0, 'pending'); + } +} + +sub scp_put { + my $file = shift; + my $destination = shift; + my $cmd; + if ($SEC_HOST ne '') { + $cmd = "$scp $file ${DMZ_HOST}:${SEC_HOST}:${destination}"; + } + else { + $cmd = "$scp $file $DMZ_HOST:${destination}"; + } + + my $directory = dirname($destination); + &ssh_exec_command("mkdir -p $directory"); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("failed to send file $file to LANL", $remote_id, $error_code); + } +} + +sub scp_get { + my $destination = shift; + my $file = shift; + my $cmd; + if ($SEC_HOST ne '') { + $cmd = "$scp ${DMZ_HOST}:${SEC_HOST}:${destination} $file "; + } + else { + $cmd = "$scp $DMZ_HOST:${destination} $file"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("failed to get file $file from LANL", $remote_id, $error_code); + } +} + +sub ssh_exec_command { + my $cmd = shift; + if ($SEC_HOST ne '') { + $cmd = "$ssh -n $DMZ_HOST ssh ${SEC_HOST} $cmd"; + } + else { + $cmd = "$ssh -n $DMZ_HOST $cmd"; + } + + print "EXEC: $cmd\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + # If we failed, see if we failed due to authorization. + check_ssh_connection(); + &my_die("Failed to execute remote command: >>$cmd<<", $remote_id, $error_code); + } + return ($stdout_buf); +} + +# neb URI to (ipp_disk,remote_disk) +sub uri_convert { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die("Failed to generate or find uri $neb_uri", $remote_id, $PS_EXIT_SYS_ERROR); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +# neb URI to remote URI-on-disk +sub uri_local_to_remote { + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub my_die { + my $msg = shift; + my $id = shift; + my $exit_code = shift; + my $exit_state = shift; + my $jobid = shift; + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $id and not $no_update) { + my $command = "$remotetool -updaterun -remote_id $id"; + $command .= " -fault $exit_code " if defined $exit_code; + $command .= " -job_id $job_id " if defined $jobid; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} + +# Quick review: +# new -> pending -> run -> full +# auth Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_remote_poll.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_remote_poll.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_remote_poll.pl (revision 41105) @@ -0,0 +1,730 @@ +#!/usr/bin/env perl + +# we have a remoteRun with an associated job_id in state of run +# 1) poll until MOAB says the processing has completed +# 2) check the status of the jobs by looking for dbinfo files on the remote server +# 3) return a list of the dbinfo files + status (exists, missing) +# 4) generate a subset transfer file with only the items that have dbinfo files? +# 5) rsync back the valid files + +# alternative method: +# 1) poll for completion as above +# 2) check for the existence of each file, generate a return table with only existing files +# 3) rsync back the existing files +# 4) run the retrieved dbinfo files + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use File::Basename; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# tools +my $missing_tools; +my $ssh = can_run('ssh') or (warn "Can't find ssh" and $missing_tools = 1); +my $scp = can_run('scp') or (warn "Can't find scp" and $missing_tools = 1); +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Options +my ($remote_id,$path_base,$skip_poll,$skip_transfer,$job_id,$dbname,$retry,$verbose,$no_update,$camera,$cmd_recipe); +$verbose = 0; +GetOptions( + 'remote_id=s' => \$remote_id, + 'job_id=s' => \$job_id, + 'path_base=s' => \$path_base, + 'skip_poll' => \$skip_poll, + 'skip_transfer' => \$skip_transfer, + 'camera=s' => \$camera, + 'dbname=s' => \$dbname, + 'recipe=s' => \$cmd_recipe, + 'retry' => \$retry, + 'verbose' => \$verbose, + 'no_update' => \$no_update, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --job_id --path_base --recipe", -exitval => 3) unless + defined($path_base) and + defined($remote_id) and + defined($cmd_recipe) and + defined($job_id); + + + +# Now accessible from a recipe +my %remote_recipe = (); +{ + my $verbose = 0; + my $conf_cmd = "$ppConfigDump -dump-recipe REMOTE -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $conf_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", -1, $PS_EXIT_SYS_ERROR); + } + my $mdcParser = PS::IPP::Metadata::Config->new; + my $metadata = $mdcParser->parse(join "", @$stdout_buf); + + my $active_recipe = ''; + my %recipes = (); + +# print Dumper($metadata); + foreach my $entry (@{ $metadata }) { + if (${ $entry }{name} eq 'ACTIVE') { + $active_recipe = ${ $entry }{value}; # Not actually used + } + else { + if (${ $entry }{class} eq 'metadata') { # A real recipe + my $name = ${ $entry }{name}; + foreach my $tentry (@{ ${ $entry }{value} }) { + if (${ $tentry }{class} eq 'scalar') { # A recipe value + $recipes{$name}{${ $tentry }{name}} = ${ $tentry }{value}; + } + elsif (${ $tentry }{class} eq 'metadata') { # A recipe array + foreach my $arr_entry (@{ ${ $tentry }{value} }) { + push @{ $recipes{$name}{${ $tentry }{name}} }, ${ $arr_entry }{value}; + } + } + } + } + } + } + + unless (exists($recipes{$cmd_recipe})) { &my_die("Cannot find recipe $cmd_recipe", -1, $PS_EXIT_CONFIG_ERROR) }; +# print Dumper(%recipes); + %remote_recipe = %{ $recipes{$cmd_recipe} }; # Select the appropriate recipe. +# print Dumper(\%remote_recipe); +} + + +# Hard coded values +my $DMZ_HOST = $remote_recipe{DMZ_HOST}; +my @SEC_HOSTS = (); +my $SEC_HOST = ''; + +if (defined($remote_recipe{SEC_HOST})) { + @SEC_HOSTS = @{ $remote_recipe{SEC_HOST} }; + if ($#SEC_HOSTS != -1) { + $SEC_HOST = $SEC_HOSTS[int(rand(@SEC_HOSTS))]; + } + else { + $SEC_HOST = ''; + } +} +my $IPP_PATH = $remote_recipe{IPP_PATH}; +my $remote_root = $remote_recipe{REMOTE_ROOT}; + + +my $ipprc = PS::IPP::Config->new( $camera ) or &my_die( "Unable to set up", $remote_id); +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# STEP 1: See if we can actually do anything. +# If the link is down, there's no benefit in trying to do anything else. +&check_ssh_connection(); + +print "passed authentication challenge.\n"; + +# STEP 2: Grab the information about this run; +my $runData; +{ + my $command = "$remotetool -listrun -remote_id $remote_id "; + $command .= " -dbname $dbname " if defined($dbname); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run remotetool to determine remote run status", $remote_id, $error_code); + } + + my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to run remotetool to determine remote run status", $remote_id, $error_code); + + my $metadata = parse_md_list($MDlist); + $runData = $metadata->[0]; # There should be only one +} +my $stage = $runData->{stage}; + +# STEP 3: Poll the job status +my $poll_response = 0; +my $poll_word = "nothing"; + +if ($skip_poll) { + $poll_word = "Completed"; +} else { + + my $poll_file = "$remote_root/stask_logs/$runData->{stage}.$remote_id.out"; + ($poll_response,$poll_word) = poll_job_alt($poll_file); + + # ($poll_response,$poll_word) = poll_job($job_id); + + if ($poll_response == -1) { # This job has an error + print "The job exited incorrectly: $remote_id $job_id $poll_word $poll_response.\n"; + # warn("The job exited incorrectly: $remote_id $job_id $poll_word."); + &my_die("problem with MOAB processing?", $remote_id, $PS_EXIT_SYS_ERROR); + exit (2); + } + + if ($poll_response != 1) { # This job has NOT completed + print "The job has not exited at LANL: $remote_id $job_id $poll_word $poll_response.\n"; + # NOTE: this should not be a failure condition + exit (0); + } +} + +my $remote_path = uri_local_to_remote($path_base); + +# STEP 4: transfer back the files. Transfer tool should check the +# existence of files on the remote end and only return those that +# exist +unless ($skip_transfer) { + my $offset = 0; # Offset to start from. + my $iter = 0; + my $transfer_success = 1; + do { + $transfer_success = 1; + $iter++; + check_ssh_connection(); + my $return_push_output = ssh_exec_command("${remote_root}/sc_transfer_tool.pl --input $remote_path --offset $offset"); + my $return_push_output_print = join "\n", @{ $return_push_output }; + if ($return_push_output_print =~ /exited with value 255/) { $transfer_success = 0; } + print "$return_push_output_print\n"; + } while (($transfer_success != 1) && ($iter < 10)); # Try harder; + + if (!$transfer_success) { &my_die ("failed to get all return files", $remote_id, 23); } +} +print STDERR "rsync of all files is complete, checking the results\n"; + +# STEP 5: grab the .stat file from LANL (this file is first constructed at LANL) + +my $uri_stats = $path_base . ".stat"; +my $disk_stats = $ipprc->file_resolve($uri_stats, 1); +my $remote_stats = uri_local_to_remote($uri_stats); + +scp_get($remote_stats,$disk_stats); + +# STEP 6: check dbinfo files for PASS / PART / FAIL + +my %stage_pass = (); +my %stage_fail = (); +my %stage_part = (); + +my $Npass = 0; +my $Npart = 0; +my $Nfail = 0; +my @dbinfo_files = (); +open (STATFILE, "$disk_stats") || &my_die("Couldn't open file? $disk_stats", $remote_id, $PS_EXIT_SYS_ERROR); +while (my $line = ) { + chomp $line; +# unless ($line =~ /dbinfo/) { next; } + + my @words = split (" ", $line); + + my ($stage_id, $class_id, $component) = get_stage_id_from_filename ($words[0],$stage); + unless(defined($stage_id)) { + print STDERR "Unable to convert file: $words[0]\n"; + next; + } +# print STDERR "stage_id : $stage_id, class_id: $class_id, \n"; + + if ($words[1] eq "PASS") { + if ($line =~ /dbinfo/) { + push @dbinfo_files, $words[0]; + } + $stage_pass{$stage_id} = 1; + $Npass ++; + } elsif ($words[1] eq "FAIL") { + $stage_fail{$stage_id} = 1; + $Nfail ++; + } elsif ($words[1] eq "PART") { + $stage_part{$stage_id} = 1; + $Npart ++; + } +} +close (STATFILE); +print STDERR "dbinfo files: $Npass PASS, $Nfail FAIL, $Npart PART\n"; + +# STEP 7: if dbinfo is PASS, execute it (fail ones that are not PASS?). +if (1) { + foreach my $file (@dbinfo_files) { + my ($stage_id, $class_id) = get_stage_id_from_dbinfo ($file); + if (defined($stage_part{$stage_id})|| + defined($stage_fail{$stage_id})) { + print STDERR "Skipping $file as it is not complete: " . $stage_part{$stage_id} . " " . $stage_fail{$stage_id} . "\n"; + next; + + } + open(DBF,"$file") || warn "Missing file $file\n"; + my $cmd = ; + close(DBF); + chomp($cmd); + + $cmd =~ s/-/ -/g; # This is just a safety check for missing space. + + if ($cmd eq "") { + print STDERR "problem: empty dbinfo file\n"; + exit (1); + next; + } + + print "dbinfo: $file\n"; + + if ($retry) { + # use the dbinfo filename to get stage id, check if we have already updated this entry: + my ($stage_id, $class_id) = get_stage_id_from_dbinfo ($file); + + # we just need to check for the existence of an entry: + if ($runData->{stage} eq "chip") { + my $cmd1 = "$chiptool -simple -processedimfile -chip_id $stage_id -class_id $class_id"; + $cmd1 .= " -dbname $dbname " if defined($dbname); + + my ( $success1, $error_code1, $full_buf1, $stdout_buf1, $stderr_buf1 ) = + run(command => $cmd1, verbose => 0); + + unless ($success1) { + $error_code1 = (($error_code1 >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run chiptool to check on results", $remote_id, $error_code1); + } + + my $Nrows = @$stdout_buf1; + if ($Nrows > 0) { + print STDERR "already updated: $stage_id, $class_id\n"; + next; + } + } elsif ($runData->{stage} eq "camera") { + my $cmd1 = "$camtool -simple -processedexp -cam_id $stage_id"; + $cmd1 .= " -dbname $dbname " if defined($dbname); + + my ( $success1, $error_code1, $full_buf1, $stdout_buf1, $stderr_buf1 ) = + run(command => $cmd1, verbose => 0); + + unless ($success1) { + $error_code1 = (($error_code1 >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run chiptool to check on results", $remote_id, $error_code1); + } + + my $Nrows = @$stdout_buf1; + if ($Nrows > 0) { + print STDERR "already updated: cam_id: $stage_id\n"; + next; + } + } elsif ($runData->{stage} eq "warp") { + my $cmd1 = "$warptool -simple -warped -warp_id $stage_id -skycell_id $class_id"; + $cmd1 .= " -dbname $dbname " if defined($dbname); + + my ( $success1, $error_code1, $full_buf1, $stdout_buf1, $stderr_buf1 ) = + run(command => $cmd1, verbose => 0); + + unless ($success1) { + $error_code1 = (($error_code1 >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run chiptool to check on results", $remote_id, $error_code1); + } + + my $Nrows = @$stdout_buf1; + if ($Nrows > 0) { + print STDERR "already updated: warp_id: $stage_id, $class_id\n"; + next; + } + } else { + print STDERR "do not know how to handle stage $runData->{stage}\n"; + exit (3); + } + } + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + # This shouldn't fail, but we also can't suddenly abort if something does fail. + # Now we're going to drop the component that owns this dbinfo, which should force a retry. + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("The command that shouldn't fail has failed: $file $cmd $remote_id $error_code"); + my ($stage_id, $class_id) = get_stage_id_from_dbinfo ($file); + $stage_fail{$stage_id} = 1; + } + } + } + print STDERR "dbinfo files all run (or skipped)\n"; +} + +# STEP 8: unify the stage states and update the remoteComponent entries +foreach my $entry (keys (%stage_fail)) { + $stage_pass{$entry} = 0; +} +foreach my $entry (keys (%stage_part)) { + $stage_pass{$entry} = 0; +} +foreach my $entry (keys (%stage_pass)) { + my $cmd = "remotetool -updatecomponent -remote_id $remote_id -stage_id $entry"; + $cmd .= " -dbname $dbname " if defined($dbname); + if ($stage_pass{$entry}) { + $cmd .= " -set_state pass"; + } else { + $cmd .= " -set_state fail"; + } + + unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + &my_die("Unable to run remotetool to determine remote run status", $remote_id); + } + } else { + print STDERR "no_update: $cmd\n"; + } +} + +# We're done, so set the state and exit. +&my_die("Finished", $remote_id, 0, "full"); + +# END PROGRAM + +sub check_ssh_connection { + my $cmd = "$ssh -O check $DMZ_HOST"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Authorization check failed.",$remote_id,0,'auth'); + } +} + +sub scp_put { + my $file = shift; + my $destination = shift; + my $cmd; + if ($SEC_HOST ne '') { + $cmd = "$scp $file ${DMZ_HOST}:${SEC_HOST}:${destination}"; + } + else { + $cmd = "$scp $file ${DMZ_HOST}:${destination}"; + } + + my $directory = dirname($destination); + ssh_exec_command("mkdir -p $directory"); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Failed to send file $file to LANL", $remote_id, $PS_EXIT_SYS_ERROR); + } +} + +sub scp_get { + my $destination = shift; + my $file = shift; + my $cmd; + if ($SEC_HOST ne '') { + $cmd = "$scp ${DMZ_HOST}:${SEC_HOST}:${destination} $file "; + } + else { + $cmd = "$scp ${DMZ_HOST}:${destination} $file"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Failed to get file $file from LANL", $remote_id, $PS_EXIT_SYS_ERROR); + } +} + +sub ssh_exec_command { + my $cmd = shift; + + if ($SEC_HOST ne '') { + $cmd = "$ssh -n $DMZ_HOST ssh ${SEC_HOST} $cmd"; + } + else { + $cmd = "$ssh -n $DMZ_HOST $cmd"; + } + + print "EXEC: $cmd\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + # If we failed, see if we failed due to authorization. + check_ssh_connection(); + &my_die("Failed to execute command: >>$cmd<<", $remote_id, $PS_EXIT_SYS_ERROR); + } + return ($stdout_buf); +} + +sub poll_job_alt { + my $poll_file = shift; + + my $response_array = ssh_exec_command("$remote_root/sc_checkjob.pl --poll_file $poll_file"); + my $response = join "\n", @$response_array; + + print STDERR "response: $response\n"; + + if ($response =~ /STATUS: RUNNING/) { + return(0,"Running"); + } + elsif ($response =~ /STATUS: COMPLETED/) { + return(1,"Completed"); + } + elsif ($response =~ /STATUS: PENDING/) { + return(-2,"Idle"); + } + else { + my $response_word = $response; + $response_word =~ s/.*State: //; + $response_word =~ s/\n.*//; + return(-1,$response_word); + } +} + + +sub poll_job { + my $job_id = shift; + my $response_array = ssh_exec_command("checkjob -v $job_id"); + my $response = join "\n", @$response_array; + + if ($response =~ /State: Running/) { + return(0,"Running"); + } + elsif ($response =~ /State: Completed/) { + return(1,"Completed"); + } + elsif ($response =~ /State: Idle/) { + return(-2,"Idle"); + } + else { + my $response_word = $response; + $response_word =~ s/.*State: //; + $response_word =~ s/\n.*//; + return(-1,$response_word); + } +} + + +sub uri_convert { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + &my_die("Failed to generate or find uri $neb_uri", $remote_id, $PS_EXIT_SYS_ERROR); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + +# print TRANSFER "$ipp_disk\n"; +# print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} + +# assumes $runData->{stage} exists +sub get_stage_id_from_dbinfo { + my $file = shift; + + my $stage_id = 0; + my $class_id = 0; + + # Steal the stage_id from the filename. This isn't something I'm happy about. + my $stage = $runData->{stage}; + if ($stage eq 'chip') { + ($stage_id, $class_id) = $file =~ /ch\.(\d*).(XY\d\d).dbinfo/; + } + elsif ($stage eq 'camera') { + ($stage_id) = $file =~ /cm\.(\d*).dbinfo/; + $class_id = 0; + } + elsif ($stage eq 'warp') { + ($stage_id, $class_id) = $file =~ /wrp\.(\d*)\.(skycell.\d\d\d\d.\d\d\d).dbinfo/; + } + elsif ($stage eq 'stack') { + print STDERR "dbinfo: $file\n"; + ($class_id, $stage_id) = $file =~ /(skycell.\d\d\d\d.\d\d\d).stk.(\d*).dbinfo/; + } + elsif ($stage eq 'staticsky') { + ($class_id, $stage_id) = $file =~ /(skycell.\d\d\d\d.\d\d\d).sky.(\d*).dbinfo/; + } + elsif ($stage eq 'diff') { + ($class_id,$stage_id) = $file =~ /(skycell.\d\d\d\d.\d\d\d).WS.dif.(\d*).dbinfo/; + } + elsif ($stage eq 'ff') { + ($class_id,$stage_id) = $file =~ /wrp\.(\d*).ff.(\d*).dbinfo/; + } + return ($stage_id, $class_id); +} + +sub get_stage_id_from_filename { + my $file = shift; + my $stage = shift; + my $stage_id = -1; + my $class_id = ''; + my $component = ''; + + if ($stage eq 'chip') { + ($stage_id, $class_id, $component) = $file =~ /ch\.(\d*).(XY\d\d).([\w\.]+)$/; + } + elsif ($stage eq 'camera') { + if ($file =~ /XY/) { + ($stage_id, $class_id, $component) = $file =~ /cm\.(\d*).(XY\d\d)\.([\w\.]+)$/; + } + else { + ($stage_id, $component) = $file =~ /cm\.(\d*)\.([\w\.]+)$/; + $class_id = 0; + } + } + elsif ($stage eq 'warp') { + ($stage_id, $class_id, $component) = $file =~ /wrp\.(\d*)\.(skycell.\d\d\d\d.\d\d\d).([\w\.]+)$/; + } + elsif ($stage eq 'stack') { + ($stage_id, $component) = $file =~ /stk\.(\d*)\.([\w\.]+)$/; + $class_id = 0; + } + elsif ($stage eq 'staticsky') { + ($class_id, $stage_id, $component) = $file =~ /(skycell.\d\d\d\d.\d\d\d).sky.(\d*).([\w\.]+)$/; + } + elsif ($stage eq 'diff') { + ($class_id,$stage_id, $component) = $file =~ /(skycell.\d\d\d\d.\d\d\d).WS.dif.(\d*).([\w\.]+)$/; + } + elsif ($stage eq 'ff') { + ($class_id,$stage_id, $component) = $file =~ /wrp\.(\d*).ff.(\d*).([\w\.]+)$/; + } + + return($stage_id,$class_id,$component); +} + + + +sub fail_component { + my $remote_id = shift; + my $cmd = shift; + my $file = shift; + + # Steal the stage_id from the filename. This isn't something I'm happy about. + my $stage = $runData->{stage}; + my $stage_id = $file; + if ($stage eq 'chip') { + $stage_id =~ s/^.*ch\.//; + } + elsif ($stage eq 'camera') { + $stage_id =~ s/^.*cm\.//; + } + elsif ($stage eq 'warp') { + $stage_id =~ s/^.*wrp\.//; + } + elsif ($stage eq 'stack') { + $stage_id =~ s/^.*stk\.//; + } + $stage_id =~ s/\..*$//; + + print STDERR "failed component: $remote_id, $stage_id\n"; + + # Drop this from the database + ## my $drop_cmd = "$remotetool -dropcomponent -remote_id $remote_id -stage_id $stage_id "; + ## $drop_cmd .= " -dbname $dbname " if defined($dbname); + ## system($drop_cmd); +} + +sub drop_component { + my $remote_id = shift; + my $cmd = shift; + my $file = shift; + + if ($cmd eq '') { + # Zero byte file. This dbinfo was never constructed properly. + + # Steal the stage_id from the filename. This isn't something I'm happy about. + my $stage = $runData->{stage}; + my $stage_id = $file; + if ($stage eq 'chip') { + $stage_id =~ s/^.*ch\.//; + } + elsif ($stage eq 'camera') { + $stage_id =~ s/^.*cm\.//; + } + elsif ($stage eq 'warp') { + $stage_id =~ s/^.*wrp\.//; + } + elsif ($stage eq 'stack') { + $stage_id =~ s/^.*stk\.//; + } + $stage_id =~ s/\..*$//; + + # Drop this from the database + my $drop_cmd = "$remotetool -dropcomponent -remote_id $remote_id -stage_id $stage_id "; + $drop_cmd .= " -dbname $dbname " if defined($dbname); + system($drop_cmd); + } + +} + +sub my_die { + my $msg = shift; + my $id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $id and not $no_update) { + my $command = "$remotetool -updaterun -remote_id $id"; + $command .= " -fault $exit_code " if defined $exit_code; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} + +# Quick review: +# new -> pending -> run -> full +# auth Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_retry_return.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_retry_return.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_retry_return.pl (revision 41105) @@ -0,0 +1,346 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use File::Basename; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Hard coded values +my $DMZ_HOST = 'wtrw'; +my $SEC_HOST = 'mu-fe'; +my $IPP_PATH = '/turquoise/usr/projects/cosmo/mswarren/ipp/'; +my $remote_root = '/scratch3/watersc1/'; + +# tools +my $missing_tools; +my $ssh = can_run('ssh') or (warn "Can't find ssh" and $missing_tools = 1); +my $scp = can_run('scp') or (warn "Can't find scp" and $missing_tools = 1); +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Options +my ($remote_id,$path_base,$dbname,$verbose,$no_update,$camera); +$verbose = 0; +GetOptions( + 'remote_id=s' => \$remote_id, + 'path_base=s' => \$path_base, + 'camera=s' => \$camera, + 'dbname=s' => \$dbname, + 'verbose' => \$verbose, + 'no_update' => \$no_update, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --path_base", -exitval => 3) unless + defined($path_base) and + defined($remote_id); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $remote_id); +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Phase 1: See if we can actually do anything. +# If the link is down, there's no benefit in trying to do anything else. +&check_ssh_connection(); + +print "passed authentication challenge.\n"; + +# Phase 1.5: Grab the information about this run; +my $rt_cmd = "$remotetool -listrun -remote_id $remote_id "; +$rt_cmd .= " -dbname $dbname " if defined($dbname); + +my ( $rt_success, $rt_error_code, $rt_full_buf, $rt_stdout_buf, $rt_stderr_buf ) = + run(command => $rt_cmd, verbose => $verbose); +unless ($rt_success) { + $rt_error_code = (($rt_error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run remotetool to determine remote run status", + $remote_id,$rt_error_code); +} + +my $rrData = $mdcParser->parse(join "", @$rt_stdout_buf) or + &my_die("Unable to run remotetool to determine remote run status", + $remote_id,$rt_error_code); +my $rrData2 = parse_md_list($rrData); +my $runData = ${ $rrData2 }[0]; # There should be only one + +# my job ID : +my $job_id = $runData->{job_id}; +print "remote job ID: $job_id\n"; + +# Poll the job status? (check status at LANL) +my $poll_response = 0; +my $poll_word = "nothing"; +($poll_response, $poll_word) = poll_job($job_id); + +if ($poll_response == -1) { # This job has an error + print "The job exited incorrectly: $remote_id $job_id $poll_word $poll_response.\n"; + # warn("The job exited incorrectly: $remote_id $job_id $poll_word."); + exit (2); +} + +if ($poll_response != 1) { # This job has NOT completed + print "The job has not exited at LANL: $remote_id $job_id $poll_word $poll_response.\n"; + exit (2); +} + +# Initialize the remote side to sync things +my $uri_return = $path_base . ".return"; +my ($ipp_return, $remote_return) = uri_convert($uri_return); + +# Construct list of dbinfo files we'll need to execute. +my @returned_files = (); +my @dbinfo_files = (); + +# get a list of the dbinfo files +open(RETURN, "$ipp_return") || &my_die("Couldn't open file? $ipp_return", $remote_id, $PS_EXIT_SYS_ERROR); +while () { + chomp; + if ($_ =~ /dbinfo/) { + push @dbinfo_files, $_; + } +} +close(RETURN); +print STDERR "Expect $#dbinfo_files dbinfo files\n"; + +# Feed the return list into the transfer tool +# If this fails, we should exit : do not update gpc1 database until all files are back +{ + my $offset = 0; # Offset to start from. + my $iter = 0; + my $transfer_success = 1; + do { + $transfer_success = 1; + $iter++; + check_ssh_connection(); + my $return_push_output = ssh_exec_command("${remote_root}/sc_transfer_tool.pl --input $remote_return --offset $offset"); + my $return_push_output_print = join "\n", @{ $return_push_output }; + if ($return_push_output_print =~ /exited with value 255/) { $transfer_success = 0; } + print "$return_push_output_print\n"; + } while (($transfer_success != 1) && ($iter < 10)); # Try harder; + + if (!$transfer_success) { &my_die ("failed to get all return files"); } +} +print STDERR "rsync of all files is complete, updating gpc1 database\n"; + +foreach my $file (@dbinfo_files) { + + # use the dbinfo filename to get stage id, check if we have already updated this entry: + my ($stage_id, $class_id) = get_stage_id_from_dbinfo ($file); + + # chiptool -dbname -chip_id $stage_id -class_id $class_id + + # we just need to check for the existence of an entry: + if ($runData->{stage} == "chip") { + my $cmd1 = "$chiptool -simple -processedimfile -chip_id $stage_id -class_id $class_id"; + $cmd1 .= " -dbname $dbname " if defined($dbname); + + my ( $success1, $error_code1, $full_buf1, $stdout_buf1, $stderr_buf1 ) = + run(command => $cmd1, verbose => $verbose); + + unless ($success1) { + $error_code1 = (($error_code1 >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to run chiptool to check on results", $remote_id, $error_code1); + } + + my $Nrows = @$stdout_buf1; + if ($Nrows > 0) { + print STDERR "skip this entry: $stage_id, $class_id\n"; + next; + } + } else { + print STDERR "do not know how to handle stage $runData->{stage}\n"; + exit (3); + } + + open(DBF,"$file") || warn "Missing file $file\n"; + my $cmd = ; + close(DBF); + + chomp($cmd); + + $cmd =~ s/-/ -/g; # This is just a safety check for missing space. + if ($cmd == "") { + print STDERR "empty dbinfo file for $stage_id, $class_id, skipping\n"; + next; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + # This shouldn't fail, but we also can't suddenly abort if something does fail. + # Now we're going to drop the component that owns this dbinfo, which should force a retry. + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("The command that shouldn't fail has failed: $file $cmd $remote_id $error_code"); + if ($poll_word ne 'Completed') { # If the job claims it completed, then we're fighting the network. + # drop_component($remote_id,$cmd,$file); + print STDERR "we should drop this component: $cmd\n"; + } + } +} + +# We're done, so set the state and exit. +&my_die("Finished",$remote_id,0,"full"); + +# END PROGRAM + +# yes +sub check_ssh_connection { + my $cmd = "$ssh -O check $DMZ_HOST"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Authorization check failed", $remote_id, 0, 'auth'); + } +} + +sub ssh_exec_command { + my $cmd = shift; + $cmd = "$ssh $DMZ_HOST ssh ${SEC_HOST} $cmd"; + print "EXEC: $cmd\n"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + # If we failed, see if we failed due to authorization. + check_ssh_connection(); + &my_die("Failed to execute command: >>$cmd<<"); + } + return ($stdout_buf); +} + +sub uri_convert { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + my_die(); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk, $remote_disk); +} + +sub poll_job { + my $job_id = shift; + my $response_array = ssh_exec_command("checkjob -v $job_id"); + my $response = join "\n", @$response_array; + + if ($response =~ /State: Running/) { + return(0,"Running"); + } + elsif ($response =~ /State: Completed/) { + return(1,"Completed"); + } + elsif ($response =~ /State: Idle/) { + return(-2,"Idle"); + } + else { + my $response_word = $response; + $response_word =~ s/.*State: //; + $response_word =~ s/\n.*//; + return(-1,$response_word); + } +} + + +# assumes $runData->{stage} exists +sub get_stage_id_from_dbinfo { + my $file = shift; + + my $stage_id = 0; + my $class_id = 0; + + # Steal the stage_id from the filename. This isn't something I'm happy about. + my $stage = $runData->{stage}; + if ($stage eq 'chip') { + ($stage_id, $class_id) = $file =~ /ch\.(\d*).(XY\d\d).dbinfo/; + } + elsif ($stage eq 'camera') { + $stage_id =~ s/^.*cm\.//; + $class_id = 0; + } + elsif ($stage eq 'warp') { + $stage_id =~ s/^.*wrp\.//; + $class_id = 0; + } + elsif ($stage eq 'stack') { + $stage_id =~ s/^.*stk\.//; + $class_id = 0; + } + + return ($stage_id, $class_id); +} + +sub drop_component { + my $remote_id = shift; + my $cmd = shift; + my $file = shift; + + if ($cmd eq '') { + # Zero byte file. This dbinfo was never constructed properly. + + # Steal the stage_id from the filename. This isn't something I'm happy about. + my $stage = $runData->{stage}; + my $stage_id = $file; + if ($stage eq 'chip') { + $stage_id =~ s/^.*ch\.//; + } + elsif ($stage eq 'camera') { + $stage_id =~ s/^.*cm\.//; + } + elsif ($stage eq 'warp') { + $stage_id =~ s/^.*wrp\.//; + } + elsif ($stage eq 'stack') { + $stage_id =~ s/^.*stk\.//; + } + $stage_id =~ s/\..*$//; + + # Drop this from the database + my $drop_cmd = "$remotetool -dropcomponent -remote_id $remote_id -stage_id $stage_id "; + $drop_cmd .= " -dbname $dbname " if defined($dbname); + system($drop_cmd); + } + +} + +sub my_die { + my $msg = shift; + my $id = shift; + my $exit_code = shift; + my $exit_state = shift; + my $jobid = shift; + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $id and not $no_update) { + my $command = "$remotetool -updaterun -remote_id $id"; + $command .= " -fault $exit_code " if defined $exit_code; + $command .= " -job_id $job_id " if defined $jobid; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_transfer_tool.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_transfer_tool.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/sc_transfer_tool.pl (revision 41105) @@ -0,0 +1,280 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use File::Basename; +use IPC::Cmd 0.36 qw( can_run run ); +use Sys::Hostname; + +my $scp_cmd = "/usr/projects/cosmo/amd6100/bin/scp"; +my $ssh_cmd = "/usr/projects/cosmo/amd6100/bin/ssh"; + +my $remote_root = '/lustre/scratch1/turquoise/watersc1/ps1/'; + $remote_root = '/scratch3/watersc1/'; + +#my $local_raw = "${remote_root}/tmp/"; +my $local_tmp = "${remote_root}/tmp/"; +my $threads = 11; +my @hosts = ( + 'ippc20.ipp.ifa.hawaii.edu', + 'ippc21.ipp.ifa.hawaii.edu', + 'ippc22.ipp.ifa.hawaii.edu', + 'ippc23.ipp.ifa.hawaii.edu', + 'ippc24.ipp.ifa.hawaii.edu', + 'ippc25.ipp.ifa.hawaii.edu', + 'ippc26.ipp.ifa.hawaii.edu', + 'ippc27.ipp.ifa.hawaii.edu', + 'ippc28.ipp.ifa.hawaii.edu', +#'ippc29.ipp.ifa.hawaii.edu', (mark's hi-mem test machine) +#'ippc30.ipp.ifa.hawaii.edu', (postage stamp server) + 'ippc31.ipp.ifa.hawaii.edu', + 'ippc32.ipp.ifa.hawaii.edu' + ); +@hosts = (@hosts, @hosts, @hosts, @hosts, @hosts); +my %server_options = ( + 'ippc20.ipp.ifa.hawaii.edu' => '', + 'ippc21.ipp.ifa.hawaii.edu' => '', + 'ippc22.ipp.ifa.hawaii.edu' => '', + 'ippc23.ipp.ifa.hawaii.edu' => '', + 'ippc24.ipp.ifa.hawaii.edu' => '', + 'ippc25.ipp.ifa.hawaii.edu' => '', + 'ippc26.ipp.ifa.hawaii.edu' => '', # -o NoneSwitch=yes -o NoneEnabled=yes', + 'ippc27.ipp.ifa.hawaii.edu' => '', # -o NoneSwitch=yes -o NoneEnabled=yes', + 'ippc28.ipp.ifa.hawaii.edu' => '', # -o NoneSwitch=yes -o NoneEnabled=yes', + 'ippc29.ipp.ifa.hawaii.edu' => '', # -o NoneSwitch=yes -o NoneEnabled=yes', + 'ippc30.ipp.ifa.hawaii.edu' => '', # -o NoneSwitch=yes -o NoneEnabled=yes', + 'ippc31.ipp.ifa.hawaii.edu' => '', # -o NoneSwitch=yes -o NoneEnabled=yes', + 'ippc32.ipp.ifa.hawaii.edu' => '', # -o NoneSwitch=yes -o NoneEnabled=yes' + ); + +my $input_path; +my $local_file; +my $remote_file; + +my $verbose = 0; +my $fetch = 0; +my $offset = 0; +my $retry = 0; +my $quickfetch = 0; + +GetOptions( + 'threads=s' => \$threads, + 'input=s' => \$input_path, + 'offset=s' => \$offset, + 'fetch' => \$fetch, + 'verbose' => \$verbose, + 'retry' => \$retry, + 'quickfetch' => \$quickfetch, + ) or pod2usage( 2 ); +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2) if @ARGV; +pod2usage( -msg => "Required options: --input", -exitval => 3) unless + defined($input_path); + +my $hostname = hostname; +print STDERR "Running on $hostname\n"; + +# split in input file list +unless(-d $local_tmp) { system("mkdir -p $local_tmp"); } +#unless(-d $local_raw) { system("mkdir -p $local_raw"); } + +# we have two modes: fetch (-> LANL) and return (-> IPP) + +if ($fetch) { + $local_file = "$input_path.check"; + $remote_file = "$input_path.transfer"; +} else { + $local_file = "$input_path.generate"; + $remote_file = "$input_path.return"; +} +my $input_base = basename($local_file); + +unless ($retry) { + # open the input file list + open (LOCAL,$local_file) || die "Couldn't find input file specified $local_file\n"; + open (REMOTE,$remote_file) || die "Couldn't find input file specified $remote_file\n"; + + # generate N output files (to be fed to the N rsync / tar threads) + my @filehandles; + my $i; + my $line = 0; + for ($i = 0; $i < $threads; $i++) { + open($filehandles[$i], ">${local_tmp}/${input_base}.${i}"); + } + + unless ($fetch) { + my $stat_file = "$input_path.stat"; + print "STATFILE: $stat_file\n"; + open (STATFILE, ">$stat_file"); + } + + $i = 0; + while (my $Lname = ) { + my $Rname = ; + + chomp $Lname; + chomp $Rname; + + $line++; + if ($line < $offset) { next; } # I think this is off-by-one in a safe direction + + if ($line % 250 == 0) { print STDERR "line $line : $Lname\n"; } + + $i = int(rand($#filehandles + 1)); + if ($i >= $threads) { + print STDERR "HUH: impossible file handle?\n"; + die; + } + + # if we are fetching, and 'quickfetch' is requested, skip file if it exists + # NOTE: this does not check that the transfer was complete or the file is current + + if ($fetch) { + # We are fetching, and do not already have this file. + if ($quickfetch && (-e $Lname)) { next; } + print { $filehandles[$i] } "$Rname\n"; + } else { + # We are pushing, but only send back files we actually have + # we cannot have the remote file unless the local file exists + # (it is a link to the local file and is generated after the local file) + my $haveRemote = -e "$local_tmp/$Rname"; + if ($haveRemote) { + print { $filehandles[$i] } "$Rname\n"; + print STATFILE "$Rname PASS\n"; + } else { + my $haveLocal = -e $Lname; + if ($haveLocal) { + print STATFILE "$Rname PART\n"; + } else { + print STATFILE "$Rname FAIL\n"; + } + } + } + } + close(LOCAL); + close(REMOTE); + unless ($fetch) { close(STATFILE); } + + for ($i = 0; $i < $threads; $i++) { + close($filehandles[$i]); + } +} + +my $i; +# fork the rsync +my @pids = (); +for ($i = 0; $i < $threads; $i++) { + $pids[$i] = fork(); + if ($pids[$i] == 0) { + my $host = $hosts[$i]; + my $code = 0; + if ($fetch) { + $code = fetch_task($host,"${local_tmp}/${input_base}.${i}", 0); + } else { + $code = transfer_task($host,"${local_tmp}/${input_base}.${i}", 0); + } + print STDERR "$host $input_base $i $code\n"; + exit($code); + } +} + +my $global_status = 0; +for ($i = 0; $i < $threads; $i++) { + waitpid($pids[$i],0); + my $this_status = $?; + print "exit status $hosts[$i] : $this_status\n"; + if ($this_status) { $global_status = ($this_status >> 8); } +} + +for ($i = 0; $i < $threads; $i++) { +# unlink("${local_tmp}/${input_base}.${i}"); +} + +# my $scp_command = "$scp_cmd $option ${local_tmp}/${input_base}.stat $hosts[0]:/tmp/"; +# print "$scp_command\n"; +# system("$scp_command"); +# XXX check return status + +print "global status: $global_status\n"; +exit ($global_status); + +# distribute bundles to nodes + +# execute bundle transfer + +sub transfer_task { + my $destination_host = shift; + my $transfer_filelist= shift; + my $error = shift; + + my $option = $server_options{$destination_host}; + + my $command = "rsync -L --size-only --omit-dir-times -e '$ssh_cmd ${option}' --files-from=${transfer_filelist} ${local_tmp} ${destination_host}:/"; + print STDERR "$command\n"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + + my $return_value = 0; + unless ($success) { + if ($error_code =~ /value 23/) { + print STDERR "Some files failed to transfer. Partial run?\n"; + $error = 23; + $return_value = 23; + } else { + print STDERR "ERROR: $error_code\n"; + warn("Transfer of $transfer_filelist to $destination_host failed with error $error_code."); + sleep(5); + $error++; + if ($error < 4) { + $error_code = transfer_task($destination_host,$transfer_filelist,$error); + } + else { + die("Failed too many times $error $destination_host $transfer_filelist"); + } + $return_value = 1; + } + } + return($return_value); +} + +sub fetch_task { + my $destination_host = shift; + my $transfer_filelist= shift; + my $error = shift; + + my $option = $server_options{$destination_host}; + + my $command = "rsync --size-only -e '$ssh_cmd ${option}' --files-from=${transfer_filelist} ${destination_host}:/ ${local_tmp}"; + print STDERR "$command\n"; + + my $error_code = 0; + my ( $success, $error_msg, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + print "raw error_msg: $error_msg...\n"; + ($error_code) = $error_msg =~ m/exited with value (\d+)/; + warn("Transfer of files in $transfer_filelist from $destination_host failed with error ($error_code) $error_msg."); + print "*** stdout: *** \n"; + foreach my $line (@$stdout_buf) { + print STDERR "stdout: $line\n"; + } + print "*** stderr: *** \n"; + foreach my $line (@$stderr_buf) { + print STDERR "stderr: $line\n"; + } + if ($error_code == 23) { + print STDERR "Some files failed to transfer\n"; + } else { + $error++; + if ($error < 4) { + $error_code = fetch_task($destination_host,$transfer_filelist,$error); + } else { + print STDERR "Failed too many times $error $destination_host $transfer_filelist\n"; + } + } + } + return($error_code); +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/skycalibration.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/skycalibration.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/skycalibration.pl (revision 41105) @@ -0,0 +1,381 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use File::Temp qw( tempfile ); +use File::Basename; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $staticskytool = can_run('staticskytool') or (warn "Can't find staticskytool" and $missing_tools = 1); +my $psastro = can_run('psastro') or (warn "Can't find psastro" and $missing_tools = 1); +my $fhead = can_run('fhead') or (warn "Can't find fhead" and $missing_tools = 1); +my $fields = can_run('fields') or (warn "Can't find fields" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +sub HelpMessage { + print "USAGE: skycalibration.pl --skycal_id (skycal_id) --outroot (root) --camera (camera) [options]\n"; + print " --skycal_id (skycal_id) : run identifier\n"; + print " --camera (camera) : Camera name\n"; + print " --dbname (dbname) : Database name\n"; + print " --threads (N) : Number of threads to use\n"; + print " --outroot (root) : Output root name\n"; + print " --path_base (path_base) : path_base of input\n"; + print " --filter (filter) : filter of input\n"; + print " --singlefilter : the input is the result of a single filter analysis"; + print " --reduction (class) : Reduction class\n"; + print " --verbose : Be extra verbose\n"; + print " --no-update : Don't update the database?\n"; + print " --no-op : Don't do any operations?\n"; + print " --redirect-output : send output to the log file,\n"; + print " --save-temps : Save temporary files?\n"; + print " --help : show this message\n"; + exit 2; +} + +my ($skycal_id, $stack_id, $camera, $dbname, $threads, $outroot, $path_base, $filter, $singlefilter, $reduction, $verbose, $no_update, $no_op, $redirect, $save_temps); +my $run_state = 'new'; +GetOptions( + 'skycal_id=s' => \$skycal_id, # sky calibration run id + 'stack_id=s' => \$stack_id, # static sky run id + 'camera|c=s' => \$camera, # Camera name + 'dbname|d=s' => \$dbname, # Database name + 'threads=s' => \$threads, # Number of threads to use + 'outroot=s' => \$outroot, # Output root name + 'run-state=s' => \$run_state, # 'new' or 'update' + 'path_base=s' => \$path_base, # path_base of input + 'filter=s' => \$filter, # filter for input stack + 'reduction=s' => \$reduction, # Reduction class + 'singlefilter' => \$singlefilter, # input was from single filter analysis + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + 'help' => sub { HelpMessage() }, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "Required options: --skycal_id --stack_id --outroot --camera --path_base", + -exitval => 3, + ) unless + defined $skycal_id and + defined $stack_id and + defined $path_base and + defined $outroot and + defined $camera; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $skycal_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot); +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $skycal_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +my $traceDest = $ipprc->filename("TRACE.EXP", $outroot); +my $stats = $ipprc->filename("PSASTRO.STATS", $outroot); + +my $outbase = basename($outroot); + +# Get list of input images to stack photometry +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $files; + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; + +# generate the input +my $cmdflags = ""; + +unless ($run_state eq 'new' or $run_state eq 'update') { + &my_die("$run_state is not a valid value for run-state\n", $skycal_id, $PS_EXIT_CONFIG_ERROR); +} +my $updateMode = $run_state eq 'update'; + +my $recipe_psastro = $ipprc->reduction($reduction, 'STATICSKY_CALIBRATION'); # Recipe to use for psastro +unless ($recipe_psastro) { + &my_die("Couldn't find selected reduction for STATICSKY_CALIBRATION: $reduction\n", $skycal_id, $PS_EXIT_CONFIG_ERROR); +} + +# XXX: We are making the bad assumption here that the staticksky run used the same reduction class +# as this skycalRun +my $recipe_psphot = $ipprc->reduction($reduction, "STACKPHOT_PSPHOT"); +unless ($recipe_psphot) { + &my_die("Couldn't find selected reduction for STACKPHOT_PSPHOT: $reduction\n", $skycal_id, $PS_EXIT_CONFIG_ERROR); +} + +print "reduction: $reduction\n"; +print "recipe_psastro: $recipe_psastro\n"; +print "recipe_psphot: $recipe_psphot\n"; + +my $configuration = $ipprc->filename("PSASTRO.CONFIG", $outroot); + +# find input file +# First check the expected file name where the stack_id is the FILE_ID +my $file; +# if (!$singlefilter) { +if (1) { + + $file = $ipprc->filename('PSPHOT.STACK.OUTPUT', $path_base, $stack_id); + if (! $ipprc->file_resolve($file)) { + print "\nfailed to resolve $file\n"; + # file with proper file rule not found. Try older systems + if ($singlefilter) { + # input is from a single filter static sky run which used psphot instead of psphotStack + # The file rule is different for psphot + $file = $ipprc->filename('PSPHOT.OUT.CMF.MEF', $path_base); + &my_die("Unable to find input for $stack_id $filter", $skycal_id, $PS_EXIT_SYS_ERROR) + unless $ipprc->file_exists($file); + } else { + # XXX: Beginning of section that can be removed eventually + # no file with the expected name found + # assume that the input is from an early multifilter staticsky run that did not use stack_id as the FILE_ID + # but instead used FILE_ID = [0 .. num_filters-1] + if (!$filter) { + &my_die("filter not supplied unable to identify appropriate staticsky input.", $skycal_id, $PS_EXIT_SYS_ERROR); + } + print "Trying old style FILE_ID\n"; + my $max_filters = 5; + for (my $i=0; $i < $max_filters; $i++) { + my $file_id = sprintf "%03d", $i; + $file = $ipprc->filename('PSPHOT.STACK.OUTPUT', $path_base, $file_id); + my $resolved = $ipprc->file_resolve($file); + if (!$resolved) { + # we fail here assumming that if file_id N doesn't exist, neither to N+1 + print "\nfailed to resolve $file\n\n"; + &my_die("unable to identify appropriate staticsky input.", $skycal_id, $PS_EXIT_SYS_ERROR); + } + # Check the filter id for this file + my $command = "$fhead $resolved | grep FILTERID"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $skycal_id, $PS_EXIT_SYS_ERROR); + } + # Expected output: HIERARCH FPA.FILTERID = 'r.00000 ' / Filter used (parsed, abstract name) + my ($undef, undef, undef, $filt) = split " ", join("", @$stdout_buf); + my $this_filter = substr $filt, 1, 7; + + # if it matches we're done + last if $this_filter eq $filter; + + # nope loop around to try the next one + print "Input file for $filter is not $file ($this_filter)\n"; + $file = undef; + } + } + # XXX: End of section that can be removed eventually + } + if ($file) { + print "\nInput file for $stack_id filter: $filter: $file\n"; + } else { + &my_die("Unable to find input file for stack_id $stack_id.", $skycal_id, $PS_EXIT_SYS_ERROR); + } +} + +my $resolved = $ipprc->file_resolve($file); +if (!$resolved) { + &my_die("Unable to find input file: $file", $skycal_id, $PS_EXIT_SYS_ERROR); +} + +# XXX: The following is for compatability with psphotStack cmfs created prior to adding NDET +# read the input header to find the number of detections +my $compatability_flags = ""; +my $n_detections = 0; +{ + # NSTARS is buggy. It only counts sources with a model, and counts them twice. + # We want the actual number of sources (real + matched). Use the length of the psf table + my $command = "echo $resolved | $fields -n SkyChip.psf NAXIS2"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => 0); + # fields does not return 0 on success + (undef, $n_detections) = split " ", join "", @$stdout_buf; + chomp $n_detections; + &my_die("Unable to find number of detections from $file: ", $skycal_id, $PS_EXIT_SYS_ERROR) + unless defined $n_detections; + + $compatability_flags .= " -n_detections $n_detections"; + +} + + +# Perform psastro analysis +my $output_sources_filerule = 'PSASTRO.OUTPUT.CMF'; +my $quality = 0; +{ + my $command = "$psastro $outroot"; + $command .= " -file $file"; +# $command .= " -threads $threads" if defined $threads; # psastro doesn't currently accept -threads + $command .= " -recipe PSASTRO $recipe_psastro"; + $command .= " -recipe PSPHOT $recipe_psphot"; + $command .= " -F PSASTRO.OUTPUT $output_sources_filerule"; + $command .= " -Db PSASTRO.SAVE.CFF F" if $updateMode; + $command .= " -stats $stats"; + # $command .= " -recipe PPSTATS CAMSTATS"; + $command .= " -recipe PPSTATS SKYCALSTATS"; + $command .= " -dumpconfig $configuration" if $configuration; + $command .= " -tracedest $traceDest"; + $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psastro: $error_code", $skycal_id, $error_code); + } + + &my_die("Couldn't find stats file: $stats", $skycal_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($stats); + + { + my $resolved = $ipprc->file_resolve($stats) + or &my_die("failed to resolve stats file: $stats", $skycal_id, $PS_EXIT_SYS_ERROR) ; + my $command = "$ppStatsFromMetadata $resolved - STATICSKY_CAL"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psastro: $error_code", $skycal_id, $error_code); + } + $cmdflags = join "", @$stdout_buf; + chomp $cmdflags; + } + + # if ppStats didn't get n_detections use the compatability version extracted above + $cmdflags .= $compatability_flags unless ($cmdflags =~ /-n_detections/); + + ($quality) = $cmdflags =~ /-quality (\d+)/; + if (!$quality) { + my $outputSources = $ipprc->filename($output_sources_filerule, $outroot); + &my_die("Couldn't find expected output file: $outputSources", $skycal_id, $PS_EXIT_SYS_ERROR) + unless $ipprc->file_exists($outputSources); + + &my_die("Couldn't find expected output file: $configuration", $skycal_id, $PS_EXIT_SYS_ERROR) + unless $ipprc->file_exists($configuration); + } + } else { + print "Not executing: $command\n"; + } +} + + +# Add the result to the database +if (!$updateMode) { + my $command = "$staticskytool -skycal_id $skycal_id"; + $command .= " -addskycalresult -path_base $outroot"; + $command .= " $cmdflags"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + + unless($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform $command"; + warn($err_message); + exit $error_code; + } + } else { + print "skipping $command\n"; + } +} else { + if ($quality) { + # First update the result + my $command = "$staticskytool -updateskycal -skycal_id $skycal_id -set_fault 0"; + $command .= " -set_quality $quality"; + $command .= " -dbname $dbname" if defined $dbname; + + unless($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform $command"; + warn($err_message); + exit $error_code; + } + } else { + print "skipping $command\n"; + } + } + my $command = "$staticskytool -skycal_id $skycal_id"; + $command .= ' -updateskycalrun -set_state full'; + $command .= " -dbname $dbname" if defined $dbname; + + unless($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform $command"; + warn($err_message); + exit $error_code; + } + } else { + print "skipping $command\n"; + } +} + +exit 0; + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $skycal_id = shift; # Diff identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $skycal_id and not $no_update) { + my $command = "$staticskytool -skycal_id $skycal_id"; + if ($updateMode) { + $command .= " -updateskycal -set_fault $exit_code"; + } else { + $command .= " -addskycalresult -fault $exit_code"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -path_base $outroot" if defined $outroot; + } + $command .= " -dbname $dbname" if defined $dbname; + run(command => $command, verbose => $verbose); + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/skycell_jpeg.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/skycell_jpeg.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/skycell_jpeg.pl (revision 41105) @@ -0,0 +1,388 @@ +#! /usr/bin/env perl + +use warnings; +use strict; +use Carp; +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use File::Temp qw( tempfile ); + +my $db; + +my ($stage, $stage_id, $outroot, $camera, $dbname, $logfile, $verbose, $save_temps); +my $missing_tools; +my ($help,$masks); +my ($tempFile,$tempName,$maskFile,$maskName); +$verbose = 0; +my $ppSkycell = can_run('ppSkycell') or (warn "Can't find ppSkycell" and $missing_tools = 1); +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +GetOptions( + 'help|h' => \$help, + 'stage=s' => \$stage, + 'stage_id=s' => \$stage_id, + 'outroot=s' => \$outroot, + 'dbname=s' => \$dbname, + 'camera=s' => \$camera, + 'logfile=s' => \$logfile, + 'verbose' => \$verbose, + 'save_temps' => \$save_temps, + 'masks' => \$masks, +# 'no-op' => \$no_op, +# 'no-update' => \$no_update, + ) or pod2usage ( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2) if @ARGV; +pod2usage( + -msg => "Required options: --stage --stage_id --outroot\nHelpful options: --camera --dbname", + -exitval => 3, + ) unless + defined $stage and defined $stage_id and defined $outroot; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die("Unable to set up", $stage_id, $PS_EXIT_CONFIG_ERROR); # this is used for PATH, NEB filename conversions + +my %stages = ('warp' => 1, 'stack' => 1, 'diff' => 1); + +unless (exists($stages{$stage})) { + my_die("Unknown stage '$stage'",$stage_id,$PS_EXIT_UNKNOWN_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +if ($stage eq 'warp') { + my $imfiles; + my $command = "$warptool -warped -warp_id $stage_id"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to perform warptool: $error_code", $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + # no results found; + } + + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("unable to parse metadata config doc", $stage_id, $error_code); + + my %tangents = (); + + foreach my $imfile (@$imfiles) { + my $skycell_id = $imfile->{skycell_id}; + my $path_base = $imfile->{path_base}; + my $quality = $imfile->{quality}; + my $state = $imfile->{data_state}; + my $projection_cell = $skycell_id; + if ($quality != 0 or $state ne 'full') { + next; + } + + $projection_cell =~ s/^(.*)\..*$/$1/; + + unless (exists($tangents{$projection_cell})) { + # Make a temp file and fill, but be sure to save + ($tempFile, $tempName) = tempfile("/tmp/skycell.$projection_cell.XXXX", + UNLINK => !$save_temps); + $tangents{$projection_cell}{FILE} = $tempFile; + $tangents{$projection_cell}{NAME} = $tempName; + if ($masks) { + my ($maskFile, $maskName) = tempfile("/tmp/skycell.$projection_cell.masks.XXXX", + UNLINK => !$save_temps); + $tangents{$projection_cell}{MFILE} = $maskFile; + $tangents{$projection_cell}{MNAME} = $maskName; + } + } +# print "$skycell_id $projection_cell\n"; + my $file = $ipprc->filename("PSWARP.OUTPUT", $path_base, $skycell_id); +# print "$file $state $quality\n"; + my $f_fh = $tangents{$projection_cell}{FILE}; + print $f_fh "$file\n"; + if ($masks) { + my $mask = $ipprc->filename("PSWARP.OUTPUT.MASK", $path_base, $skycell_id); +# print "$mask\n"; + my $m_fh = $tangents{$projection_cell}{MFILE}; + print $m_fh "$mask\n"; + } + } + foreach my $projection_cell (keys %tangents) { + $command = "$ppSkycell -images $tangents{$projection_cell}{NAME}"; + if ($masks) { + $command .= " -masks $tangents{$projection_cell}{MNAME} "; + } + $command .= " ${outroot}.${projection_cell} "; +# print "$command\n"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to perform ppSkycell: $error_code", $stage_id, $error_code); + } + # Update database: + $command = "$warptool -addsummary -warp_id $stage_id -projection_cell $projection_cell -path_base $outroot"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to update warp summary: $error_code", $stage_id, $error_code); + } + } + if (scalar (keys %tangents) == 0) { + my $projection_cell = 'NULL'; + $command = "$warptool -addsummary -warp_id $stage_id -projection_cell $projection_cell -path_base $outroot"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to update diff summary: $error_code", $stage_id, $error_code); + } + } +} #end warp stage +if ($stage eq 'diff') { + my $imfiles; + my $command = "$difftool -diffskyfile -diff_id $stage_id"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to perform difftool: $error_code", $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + # no results found; + } + + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("unable to parse metadata config doc", $stage_id, $error_code); + + my %tangents = (); + + foreach my $imfile (@$imfiles) { + my $skycell_id = $imfile->{skycell_id}; + my $path_base = $imfile->{path_base}; + my $quality = $imfile->{quality}; + my $state = $imfile->{data_state}; + my $projection_cell = $skycell_id; + if ($quality != 0 or $state ne 'full') { + next; + } + + $projection_cell =~ s/^(.*)\..*$/$1/; + + unless (exists($tangents{$projection_cell})) { + # Make a temp file and fill, but be sure to save + ($tempFile, $tempName) = tempfile("/tmp/skycell.$projection_cell.XXXX", + UNLINK => !$save_temps); + $tangents{$projection_cell}{FILE} = $tempFile; + $tangents{$projection_cell}{NAME} = $tempName; + if ($masks) { + my ($maskFile, $maskName) = tempfile("/tmp/skycell.$projection_cell.masks.XXXX", + UNLINK => !$save_temps); + $tangents{$projection_cell}{MFILE} = $maskFile; + $tangents{$projection_cell}{MNAME} = $maskName; + } + } +# print "$skycell_id $projection_cell\n"; + my $file = $ipprc->filename("PPSUB.OUTPUT", $path_base, $skycell_id); +# print "$file $state $quality\n"; + my $f_fh = $tangents{$projection_cell}{FILE}; + print $f_fh "$file\n"; + if ($masks) { + my $mask = $ipprc->filename("PPSUB.OUTPUT.MASK", $path_base, $skycell_id); +# print "$mask\n"; + my $m_fh = $tangents{$projection_cell}{MFILE}; + print $m_fh "$mask\n"; + } + } + foreach my $projection_cell (keys %tangents) { + $command = "$ppSkycell -images $tangents{$projection_cell}{NAME}"; + if ($masks) { + $command .= " -masks $tangents{$projection_cell}{MNAME} "; + } + $command .= " ${outroot}.${projection_cell} "; +# print "$command\n"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to perform ppSkycell: $error_code", $stage_id, $error_code); + } + # Update database: + $command = "$difftool -addsummary -diff_id $stage_id -projection_cell $projection_cell -path_base $outroot"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to update diff summary: $error_code", $stage_id, $error_code); + } + } + if (scalar (keys %tangents) == 0) { + my $projection_cell = 'NULL'; + $command = "$difftool -addsummary -diff_id $stage_id -projection_cell $projection_cell -path_base $outroot"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to update diff summary: $error_code", $stage_id, $error_code); + } + } +} #end diff stage +if ($stage eq 'stack') { + my $imfiles; + my $command = "$stacktool -sassskyfile -sass_id $stage_id"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to perform stacktool: $error_code", $stage_id, $error_code); + } + + if (@$stdout_buf == 0) { + # no results found; + } + + $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + &my_die("unable to parse metadata config doc", $stage_id, $error_code); + + my %tangents = (); + + my %products = ('image' => "PPSTACK.UNCONV", +# 'mask' => "PPSTACK.UNCONV.MASK", + 'variance' => "PPSTACK.UNCONV.VARIANCE", + 'exp' => "PPSTACK.UNCONV.EXP", + 'num' => "PPSTACK.UNCONV.EXPNUM", +# 'bkg' => "PPSTACK.OUTPUT.BKGMODEL" + ); + + foreach my $imfile (@$imfiles) { + my $skycell_id = $imfile->{skycell_id}; + my $path_base = $imfile->{path_base}; + my $quality = $imfile->{quality}; + my $state = $imfile->{state}; + my $fault = $imfile->{fault}; + my $projection_cell = $skycell_id; + if ($quality != 0 or $state ne 'full') { + next; + } + + $projection_cell =~ s/^(.*)\..*$/$1/; + + unless (exists($tangents{$projection_cell})) { + # Make a temp file and fill, but be sure to save + foreach my $key (keys %products) { + ($tempFile, $tempName) = tempfile("/tmp/skycell.$projection_cell.$key.XXXX", + UNLINK => !$save_temps); + $tangents{$projection_cell}{$key}{FILE} = $tempFile; + $tangents{$projection_cell}{$key}{NAME} = $tempName; + $tangents{$projection_cell}{$key}{N} = 0; + } + } + foreach my $key (keys %products) { +# print "$skycell_id $projection_cell\n"; + my $file = $ipprc->filename($products{$key}, $path_base, $skycell_id); +# print "$file $state $quality\n"; + my $f_fh = $tangents{$projection_cell}{$key}{FILE}; + if ($ipprc->file_exists($file)) { + print $f_fh "$file\n"; + $tangents{$projection_cell}{$key}{N} ++; + } + } + } + foreach my $projection_cell (keys %tangents) { + ## Loop over results here. + # Images + # Masks + # Variances + # Nexptime + # Nexp + # Backgrounds + + foreach my $key (keys %products) { + $command = "$ppSkycell -images $tangents{$projection_cell}{$key}{NAME}"; + $command .= " ${outroot}.${projection_cell}.${key} "; + if ($key eq 'bkg') { + $command .= " -Di BIN1 1 -Di BIN2 1 "; + } + elsif ($key eq 'image') { + $command .= " -exptimeOrder 1 "; + } + elsif ($key eq 'variance') { + $command .= " -exptimeOrder 2 "; + } + # Append the image list to other objects, in case the WCS information is unpopulated + $command .= " -wcsref $tangents{$projection_cell}{image}{NAME} "; + + if ($tangents{$projection_cell}{$key}{N} > 0) { + print "$command\n"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); +# print "Was unable to perform ppSkycell $stage_id $error_code $key\n"; + &my_die("unable to perform ppSkycell: $error_code", $stage_id, $error_code); + } + } + } + + # Update database: + $command = "$stacktool -addsummary -sass_id $stage_id -projection_cell $projection_cell -path_base $outroot"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to update stack summary: $error_code", $stage_id, $error_code); + } + } + if (scalar (keys %tangents) == 0) { + my $projection_cell = 'NULL'; + $command = "$stacktool -addsummary -sass_id $stage_id -projection_cell $projection_cell -path_base $outroot"; + if (defined($dbname)) { + $command .= " -dbname $dbname"; + } +# print "$command\n"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("unable to update stack summary: $error_code", $stage_id, $error_code); + } + } + +} #end stack stage + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $stage = shift; # stage name + my $stage_id = shift; # identifier + my $exit_code = shift; # Exit code + # outputImage and path_base are globals + + carp($msg); + exit $exit_code; +} Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/stack_bkg_mk_mdc.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/stack_bkg_mk_mdc.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/stack_bkg_mk_mdc.pl (revision 41105) @@ -0,0 +1,100 @@ +#! /usr/bin/env perl + +use warnings; +use strict; +use Carp; +use DBI; +use IPC::Cmd 0.36 qw( can_run run); +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +my ($dbname,$stack_id,$sass_id,$label,$camera,$filter); + +my $ipprc = PS::IPP::Config->new(); # IPP Configuration +my $siteConfig = $ipprc->{_siteConfig}; + +#$dbname = 'gpc1'; +#$camera = 'GPC1'; +GetOptions( + 'stack_id=s' => \$stack_id, + 'sass_id=s' => \$sass_id, + 'label=s' => \$label, + 'filter=s' => \$filter, + 'dbname=s' => \$dbname, + 'camera=s' => \$camera, + ) or pod2usage ( 2 ); +pod2usage( -msg => "Required options; --stack_id | --label | --sass_id", -exitval => 3) unless + ((defined $stack_id)||(defined $label)); +pod2usage( -msg => "Required options; --camera --dbname ", -exitval => 3) unless + (defined($camera) && defined($dbname)); +my $verbose = 0; + +use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock'; +my $dbserver = metadataLookupStr($siteConfig, 'DBSERVER'); +my $dbuser = metadataLookupStr($ipprc->{_siteConfig}, "RO_DBUSER"); +my $dbpass = metadataLookupStr($ipprc->{_siteConfig}, "RO_DBPASSWORD"); +die "database configuration not set up" unless defined($dbserver); +die "database configuration not set up" unless defined($dbuser); +die "database configuration not set up" unless defined($dbpass); +my $db = DBI->connect("DBI:mysql:database=${dbname};host=${dbserver};" . + "mysql_socket=" . DB_SOCKET(), + ${dbuser},${dbpass}, + { RaiseError => 1, AutoCommit => 1} + ) or die "Unable to connect to database $DBI::errstr\n"; + +$ipprc = PS::IPP::Config->new( $camera ); +my $mdcParser = PS::IPP::Metadata::Config->new; + + +my $query = "SELECT DISTINCT chip_id,cam_id,path_base FROM stackRun JOIN stackInputSkyfile USING(stack_id) JOIN stackAssociationMap USING(stack_id) JOIN warpRun USING(warp_id) JOIN fakeRun USING(fake_id) JOIN camRun USING(cam_id) JOIN camProcessedExp USING(cam_id) JOIN chipRun USING (chip_id) WHERE 1 "; + +if (defined($label)) { $query .= " AND stackRun.label = '${label}' "; } +if (defined($stack_id)) { $query .= " AND stack_id = ${stack_id} "; } +if (defined($filter)) { $query .= " AND stackRun.filter = '${filter}' "; } +if (defined($sass_id)) { $query .= " AND sass_id = ${sass_id} "; } + +my $cams = $db->selectall_arrayref( $query ); + +#my $logDest = $ipprc->filename($logRule, $outroot, $class_id); + +print "backgroundStackInputs MULTI\n\n"; +my $index = 0; + +foreach my $cam (@{ $cams }) { + my ($chip_id,$cam_id,$cam_path) = @{ $cam }; + my $smf_file = $ipprc->filename("PSASTRO.OUTPUT",$cam_path); + print "backgroundStackInput${index} METADATA\n"; + print " chip_id S64 $chip_id\n"; + print " cam_id S64 $cam_id\n"; + print " astrom STR $smf_file\n"; + print " models METADATA\n"; + + my $command = "chiptool -processedimfile -chip_id $chip_id"; + $command .= " -dbname $dbname " if defined $dbname; + + my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + die "Unable to parse metadata."; + } + my $imfiles = $mdcParser->parse_list(join "", @$stdout_buf) or + die "Unabel to parse metadata: 2."; + + foreach my $imf (@$imfiles) { + my $class_id = $imf->{class_id}; + my $path_base= $imf->{path_base}; + + my $model = $ipprc->filename("PPIMAGE.BACKMDL",$path_base,$class_id); + + print " ${class_id} STR $model\n"; + } + print " END\n"; + print "END\n\n"; + + $index++; +} + Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/stack_skycell.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/stack_skycell.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/stack_skycell.pl (revision 41105) @@ -0,0 +1,558 @@ +#!/usr/bin/env perl + +use warnings; +use strict; +use Carp; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use File::Temp qw( tempfile ); +use File::Basename; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); +my $ppStack = can_run('ppStack') or (warn "Can't find ppStack" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($stack_id, $dbname, $outroot, $debug, $run_state, $threads, $reduction, $verbose, $no_update, $no_op, $redirect, $save_temps, $delete_convolved_images); +GetOptions( + 'stack_id|d=s' => \$stack_id, # Stack identifier + ## XXX future addition: if stack gets multi-skyfile option 'stack_skyfile_id|d=s' => \$stack_skyfile_id, # Stack identifier + 'dbname|d=s' => \$dbname, # Database name + 'outroot=s' => \$outroot, # Output root name + 'run-state=s' => \$run_state, + 'debug' => \$debug, # Print to stdout + 'threads=s' => \$threads, # Number of threads to use for ppStack + 'reduction=s' => \$reduction, # Reduction class + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + 'delete-convolved' => \$delete_convolved_images, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --stack_id --outroot --run-state", + -exitval => 3, + ) unless defined $stack_id + and defined $outroot + and defined $run_state; + +# lists of file rules which we expect to produce output output +my @outputList = qw( +PPSTACK.OUTPUT +PPSTACK.OUTPUT.MASK +PPSTACK.OUTPUT.VARIANCE +PPSTACK.OUTPUT.EXP +PPSTACK.OUTPUT.EXPNUM +PPSTACK.OUTPUT.EXPWT +PPSTACK.OUTPUT.JPEG1 +PPSTACK.OUTPUT.JPEG2 +PPSTACK.CONFIG +); +# produced if we run photometry +my @outputListPhotom = qw( +PSPHOT.OUT.CMF.MEF +); +# extra outputs when convolving +my @outputListUnconv = qw( +PPSTACK.TARGET.PSF +PPSTACK.UNCONV +PPSTACK.UNCONV.MASK +PPSTACK.UNCONV.VARIANCE +PPSTACK.UNCONV.EXP +PPSTACK.UNCONV.EXPNUM +PPSTACK.UNCONV.EXPWT +); + + +my $ipprc = PS::IPP::Config->new() or my_die( "Unable to set up", $stack_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$| = 1; +print "I've set up: $stack_id\n"; + +# XXX camera is not known here; cannot use filerules... +# my $logDest = $ipprc->filename("LOG.EXP", $outroot); +my $logDest = "$outroot.log"; + +if ($run_state eq 'update') { + $logDest .= ".update"; +} + +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $stack_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +my $neb; +my $scheme = file_scheme($outroot); +if ($scheme and $scheme eq 'neb') { + $neb = $ipprc->nebulous(); +} + + +my $temp_images_exist = 0; +my $image_id = $stack_id; +my $source_id = $ipprc->source_id($dbname, $PS_TABLE_ID_STACK); + +# Get list of components for stacking +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $files; +{ + my $command = "$stacktool -inputskyfile -stack_id $stack_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool -inputskyfile: $error_code", $stack_id, $error_code); + } + + if (@$stdout_buf == 0) { + &my_die("No input skyfiles selected", $stack_id, $PS_EXIT_PROG_ERROR); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $stack_id, $PS_EXIT_PROG_ERROR); + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $stack_id, $PS_EXIT_PROG_ERROR); +} + +&my_die("Stack list contains less than two elements", $stack_id, $PS_EXIT_DATA_ERROR) unless + scalar @$files >= 2; + +print "I've loaded my inputs: $stack_id\n"; + +# Parse the list of input files to get the tesselation, skycell identifiers and camera +my $skycell_id; # Skycell identifier +my $tess_id; # Tesselation identifier +my $camera; # Camera +foreach my $file (@$files) { + # skip warps which are specified as 'ignored' + if ($file->{ignored}) { next; } + if (defined $tess_id) { + &my_die("Tesselation identifiers don't match", $stack_id, $PS_EXIT_DATA_ERROR) unless + $file->{tess_id} eq $tess_id; + } else { + $tess_id = $file->{tess_id}; + } + if (defined $skycell_id) { + &my_die("Skycell identifiers don't match", $stack_id, $PS_EXIT_DATA_ERROR) unless + $file->{skycell_id} eq $skycell_id; + } else { + $skycell_id = $file->{skycell_id}; + } + if (defined $camera) { + &my_die("Cameras don't match", $stack_id, $PS_EXIT_DATA_ERROR) unless $file->{camera} eq $camera; + } else { + $camera = $file->{camera}; + } +} + +&my_die("Can't find camera", $stack_id, $PS_EXIT_SYS_ERROR) unless defined $camera; +$ipprc->define_camera($camera); + +print "I've configured everything: $stack_id\n"; + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_ppStack = $ipprc->reduction($reduction, 'STACK_PPSTACK'); # Recipe to use for ppStack +my $recipe_ppSub = $ipprc->reduction($reduction, 'STACK_PPSUB'); # Recipe to use for ppSub +my $recipe_psphot = $ipprc->reduction($reduction, 'STACK_PSPHOT'); # Recipe to use for psphot +my $recipe_ppstats = 'STACKSTATS'; +if ($ +run_state eq 'update') { + $recipe_ppstats = 'WARPSTATS'; +} +unless ($recipe_ppStack and $recipe_ppSub and $recipe_psphot) { + &my_die("Couldn't find selected reduction for STACK_PPSTACK, STACK_PPSUB and STACK_PSPHOT: $reduction\n", $stack_id, $PS_EXIT_CONFIG_ERROR); +} + +my $recipe; +{ + my $command = "$ppConfigDump -camera $camera -recipe PPSTACK $recipe_ppStack -dump-recipe PPSTACK -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $stack_id, $error_code); + } + $recipe = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $stack_id, $PS_EXIT_PROG_ERROR); +} +my $convolve = metadataLookupBool($recipe, 'CONVOLVE'); # Convolve inputs? +my $photometry = metadataLookupBool($recipe, 'PHOTOMETRY'); # perform photometry? +my $output_nocomp = metadataLookupBool($recipe, 'OUTPUT.NOCOMP'); # change filerules to produced uncompressed output images +my $output_logflux = metadataLookupBool($recipe, 'OUTPUT.LOGFLUX'); # change filerules to produce logflux compressed output images. +my $replicate_outputs = (defined($neb) and metadataLookupBool($recipe, 'OUTPUT.REPLICATE')); # replicate output images +if ($output_nocomp and $output_logflux) { + &my_die("Unable to not compress and logflux compress simultaneously. Check config.",$stack_id, $PS_EXIT_CONFIG_ERROR); +} +my $stack_type = metadataLookupStr($recipe, 'STACK.TYPE'); +&my_die("STACK.TYPE not found in recipe. Check config.",$stack_id, $PS_EXIT_CONFIG_ERROR) unless $stack_type; + +# Generate MDC file with the inputs +my $tess_base = basename($tess_id); +my ($listFile, $listName) = tempfile("/tmp/$tess_base.$skycell_id.stk.$stack_id.list.XXXX", UNLINK => !$save_temps ); +my $num = 0; +my $inputSources; # Sources to use as stamps +foreach my $file (@$files) { + if ($file->{ignored}) { next; } + + print $listFile "INPUT$num\tMETADATA\n"; + $num++; + +# my $image = $file->{uri}; # Image name + my $image = $ipprc->filename("PSWARP.OUTPUT", $file->{path_base} ); # Image name + my $mask = $ipprc->filename( "PSWARP.OUTPUT.MASK", $file->{path_base} ); # Mask name + my $weight = $ipprc->filename( "PSWARP.OUTPUT.VARIANCE", $file->{path_base} ); # Weight name + my $psf = $convolve ? $ipprc->filename( "PSPHOT.PSF.SKY.SAVE", $file->{path_base} ) : undef; # PSF name + my $sources = $ipprc->filename("PSWARP.OUTPUT.SOURCES", $file->{path_base}); # Sources name + + my $bkgmodel = $ipprc->filename("PSWARP.OUTPUT.BKGMODEL", $file->{path_base}); + + &my_die("Image $image does not exist", $stack_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists( $image ); + &my_die("Mask $mask does not exist", $stack_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists( $mask ); + &my_die("Weight $weight does not exist", $stack_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists( $weight ); + &my_die("PSF $psf does not exist", $stack_id, $PS_EXIT_SYS_ERROR) if ($convolve and not $ipprc->file_exists( $psf )); + &my_die("Sources $sources does not exist", $stack_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists( $sources ); + + print $listFile "\tIMAGE\tSTR\t" . $image . "\n"; + print $listFile "\tMASK\tSTR\t" . $mask . "\n"; + print $listFile "\tVARIANCE\tSTR\t" . $weight . "\n"; + print $listFile "\tPSF\tSTR\t" . $psf . "\n" if $convolve; + print $listFile "\tSOURCES\tSTR\t" . $sources . "\n"; + print $listFile "\tBKGMODEL\tSTR\t" . $bkgmodel . "\n" if $ipprc->file_exists( $bkgmodel ); + + print $listFile "END\n\n"; +} +close($listFile); + +print "I've checked everything: $stack_id\n"; + +# Prepare the output files +my @outputFiles; +prepare_outputs(\@outputFiles, \@outputList, $outroot); +prepare_outputs(\@outputFiles, \@outputListPhotom, $outroot) if $photometry; +prepare_outputs(\@outputFiles, \@outputListUnconv, $outroot) if $convolve; + +# we need the output image name for the database +my $outputName = $outputFiles[0]; + +## use an explicit stack name for psphot output objects +my $do_stats = 1; +my $outputStats; +my $traceDest; +my $configuration = prepare_output("PPSTACK.CONFIG", $outroot, 1); +if ($run_state eq 'new') { + $outputStats = prepare_output("SKYCELL.STATS", $outroot, 1); + $traceDest = prepare_output("TRACE.EXP", $outroot, 1); + push @outputFiles, $configuration; + push @outputFiles, $outputStats; +} else { + # we need to do stats regardless because we need the quality flag + # $do_stats = 0; + $outputStats = prepare_output("SKYCELL.STATS.UPDATE", $outroot, 1) if $do_stats; + $traceDest = prepare_output("TRACE.EXP.UPDATE", $outroot, 1); +} + +$temp_images_exist = 1; # failures after this point should attempt to delete the temp images + +my $cmdflags; + +# Perform stacking +unless ($no_op) { + my $command = "$ppStack -input $listName $outroot"; + $command .= " -stats $outputStats" if $do_stats; + $command .= " -recipe PPSTACK $recipe_ppStack"; + $command .= " -recipe PPSUB $recipe_ppSub"; + $command .= " -recipe PSPHOT $recipe_psphot"; + $command .= " -recipe PPSTATS $recipe_ppstats" if $do_stats;; + $command .= " -stack-type $stack_type"; + $command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE"; + $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + $command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF"; + $command .= " -F SOURCE.PLOT.MOMENTS SOURCE.PLOT.SKY.MOMENTS"; + $command .= " -F SOURCE.PLOT.PSFMODEL SOURCE.PLOT.SKY.PSFMODEL"; + $command .= " -F SOURCE.PLOT.APRESID SOURCE.PLOT.SKY.APRESID"; + if ($output_nocomp) { + $command .= " -F PPSTACK.OUTPUT PPSTACK.OUTPUT.NOCOMP"; + $command .= " -F PPSTACK.OUTPUT.VARIANCE PPSTACK.OUTPUT.VARIANCE.NOCOMP"; + $command .= " -F PPSTACK.OUTPUT.EXPWT PPSTACK.OUTPUT.EXPWT.NOCOMP"; + $command .= " -F PPSTACK.OUTPUT.EXP PPSTACK.OUTPUT.EXP.NOCOMP"; + $command .= " -F PPSTACK.UNCONV PPSTACK.UNCONV.NOCOMP"; + $command .= " -F PPSTACK.UNCONV.VARIANCE PPSTACK.UNCONV.VARIANCE.NOCOMP"; + $command .= " -F PPSTACK.UNCONV.EXPWT PPSTACK.UNCONV.EXPWT.NOCOMP"; + $command .= " -F PPSTACK.UNCONV.EXP PPSTACK.UNCONV.EXP.NOCOMP"; + } + if ($output_logflux) { + $command .= " -R PPSTACK.OUTPUT FITS.TYPE COMP_STACK "; # Just this one output component? + $command .= " -R PPSTACK.OUTPUT.VARIANCE FITS.TYPE COMP_STACK "; +# $command .= " -R PPSTACK.OUTPUT.EXPWT FITS.TYPE COMP_STACK "; + $command .= " -R PPSTACK.UNCONV FITS.TYPE COMP_STACK "; + $command .= " -R PPSTACK.UNCONV.VARIANCE FITS.TYPE COMP_STACK "; +# $command .= " -R PPSTACK.UNCONV.EXPWT FITS.TYPE COMP_STACK "; + } + $command .= " -threads $threads" if defined $threads; + $command .= " -debug-stack" if defined $debug; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " -image_id $image_id" if defined $image_id; + $command .= " -source_id $source_id" if defined $source_id; + + $command .= " -stack_id $stack_id" if defined $stack_id; + $command .= " -skycell_id $skycell_id" if defined $skycell_id; + $command .= " -tess_id $tess_base" if defined $tess_base; + + if ($run_state eq 'new') { + $command .= " -dumpconfig $configuration"; + } else { + $command .= " -ipprc $configuration"; + } + + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStack: $error_code", $stack_id, $error_code); + } + + my $quality; # Quality flag + if ($do_stats) { + my $outputStatsReal = $ipprc->file_resolve($outputStats); + &my_die("Couldn't find expected output file: $outputStats", $stack_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + # measure stats + $command = "$ppStatsFromMetadata $outputStatsReal - STACK_SKYCELL"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $stack_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + } + + if (!$quality) { + + + check_outputs(\@outputFiles, $replicate_outputs); + + if (($convolve)&&($delete_convolved_images)) { # We made convolved products, but do not wish to keep them anymore + my @products_to_clear = ('PPSTACK.OUTPUT', + 'PPSTACK.OUTPUT.MASK', + 'PPSTACK.OUTPUT.VARIANCE', + 'PPSTACK.OUTPUT.EXP', + 'PPSTACK.OUTPUT.EXPNUM', + 'PPSTACK.OUTPUT.EXPWT'); + foreach my $product (@products_to_clear) { + my $file = $ipprc->filename($product,$outroot,$skycell_id); + print "Deleting unwanted convolved product: $file\n"; + my $error= $ipprc->kill_file($file); + if ($error_code) { + print "Failed to delete unwanted convolved product: $error_code\n"; + } + } + } + + } + + print "I've stacked $listName: $stack_id\n"; +} + +delete_temps() unless ($save_temps); + +unless ($no_update) { + + # Add the stack result + { + my $command = "$stacktool"; + my $mode; + if ($run_state eq 'new') { + $mode = "-addsumskyfile"; + $command .= " -uri $outputName -path_base $outroot"; + $command .= " -hostname $host" if defined $host; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + } else { + $mode = "-updaterun -set_state full"; + } + $command .= " $mode -stack_id $stack_id"; + $command .= " $cmdflags" if $do_stats; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform stacktool $mode $error_code", $stack_id, $error_code); + } + } + +} + +print "I've updated the database: $stack_id\n"; + + +my $my_die_called = 0; +sub my_die +{ + my $msg = shift; # Warning message on die + my $stack_id = shift; # Stack identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + unless ($my_die_called) { + $my_die_called = 1; + delete_temps() unless ($save_temps); + } + + if (defined $stack_id and not $no_update) { + my $command = "$stacktool -stack_id $stack_id -fault $exit_code"; + if ($run_state eq 'new') { + $command .= " -addsumskyfile"; + $command .= " -hostname $host" if defined $host; + $command .= " -path_base $outroot" if defined $outroot; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + } else { + $command .= " -updatesumskyfile"; + } + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Ensure temporary images are deleted +sub delete_temps +{ + unless ($temp_images_exist) { + print "No temporary images yet generated\n"; + return 1; + } + + print "Ensuring temporary images are deleted.\n"; + + my $temp_delete = defined($recipe) and metadataLookupBool($recipe, 'TEMP.DELETE'); # Delete temp files? + if ($temp_delete) { + my $temp_dir = metadataLookupStr($ipprc->{_siteConfig}, 'TEMP.DIR') or &my_die("Unable to find temporary directory in site configuration", $stack_id, $PS_EXIT_CONFIG_ERROR); # Directory with temporary files + my $temp_image = metadataLookupStr($recipe, 'TEMP.IMAGE'); # Suffix for image + my $temp_mask = metadataLookupStr($recipe, 'TEMP.MASK'); # Suffix for mask + my $temp_weight = metadataLookupStr($recipe, 'TEMP.VARIANCE'); # Suffix for weight + my $temp_root = basename($outroot); # Root name for temporary files + + if (not defined $temp_dir or not defined $temp_image or not defined $temp_mask or + not defined $temp_weight) { + &my_die("Unable to find details for temporary images.", $stack_id, $PS_EXIT_CONFIG_ERROR); + } + + for (my $i = 0; $i < $num; $i++) { + foreach my $ext ( $temp_image, $temp_mask, $temp_weight ) { + my $file = $temp_dir . '/' . $temp_root . '.' . $i . '.' . $ext; + unlink $file if -e $file; + } + } + } +} +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, undef, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $stack_id, $error); + return $output; +} + +sub prepare_outputs +{ + my $fileList = shift; + my $ruleList = shift; + my $outroot = shift; + + foreach my $rule (@$ruleList) { + push @$fileList, prepare_output($rule, $outroot, 1); + } +} + +sub check_output +{ + my $file = shift; + my $replicate = shift; + + if (!defined $file) { + return; + } + + &my_die("Couldn't find expected output file: $file", $stack_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($file); + + # Funpack to confirm we've really made things correctly + my $diskfile = $ipprc->file_resolve($file); + if ($diskfile =~ /fits/) { + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $stack_id, $PS_EXIT_SYS_ERROR); + my $check_command = "$funpack -S $diskfile > /dev/null"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $check_command, verbose => $verbose); + if (!$success) { + &my_die("Output file not a valid fits file: $file", $stack_id, $PS_EXIT_SYS_ERROR); + } + } + ##### + + if ($replicate and $neb) { + $ipprc->replicate_file($file) or &my_die("failed to replicate: $file\n", $stack_id, $PS_EXIT_SYS_ERROR); + } +} + +sub check_outputs +{ + my $fileList = shift; + my $replicate = shift; + foreach my $file (@$fileList) { + check_output($file, $replicate); + } +} + +print "I've reached the end of processing with a code of $?: $stack_id\n"; + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/staticsky.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/staticsky.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/staticsky.pl (revision 41105) @@ -0,0 +1,395 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use File::Temp qw( tempfile ); +use File::Basename; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $staticskytool = can_run('staticskytool') or (warn "Can't find staticskytool" and $missing_tools = 1); +my $psphotStack = can_run('psphotStack') or (warn "Can't find psphotStack" and $missing_tools = 1); +my $psphot = can_run('psphot') or (warn "Can't find psphot" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +sub HelpMessage { + print "USAGE: staticsky.pl --sky_id (sky_id) --outroot (root) --camera (camera) [options]\n"; + print " --sky_id (sky_id) : run identifier\n"; + print " --run-state (state) : run state (new or update)\n"; + print " --camera (camera) : Camera name\n"; + print " --dbname (dbname) : Database name\n"; + print " --threads (N) : Number of threads to use\n"; + print " --outroot (root) : Output root name\n"; + print " --reduction (class) : Reduction class\n"; + print " --require_sources : Require that the stack source files exist\n"; + print " --verbose : Be extra verbose\n"; + print " --no-update : Don't update the database?\n"; + print " --no-op : Don't do any operations?\n"; + print " --redirect-output : send output to the log file,\n"; + print " --save-temps : Save temporary files?\n"; + print " --help : show this message\n"; + exit 2; +} + +# XXX test: +print "run staticsky.pl @ARGV\n"; + +my ($sky_id, $camera, $dbname, $threads, $outroot, $reduction, $require_sources, $verbose, $no_update, $no_op, $redirect, $save_temps); +my $run_state ='new'; + +GetOptions( + 'sky_id=s' => \$sky_id, # Diff identifier + 'run-state=s' => \$run_state, + 'camera|c=s' => \$camera, # Camera name + 'dbname|d=s' => \$dbname, # Database name + 'threads=s' => \$threads, # Number of threads to use + 'outroot=s' => \$outroot, # Output root name + 'reduction=s' => \$reduction, # Reduction class + 'require_sources' => \$require_sources, # Require that the stack sources exist. + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? + 'help' => sub { HelpMessage() }, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +pod2usage( + -msg => "Required options: --sky_id --outroot --camera", + -exitval => 3, + ) unless + defined $sky_id and + defined $outroot and + defined $camera; + + +&my_die("unexpected run state: $run_state", $sky_id, $PS_EXIT_PROG_ERROR) unless ($run_state eq 'new') or ($run_state eq 'update'); +my $updatemode = $run_state eq 'update'; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $sky_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot); +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $sky_id, $PS_EXIT_SYS_ERROR ) if $redirect; + +my $traceDest = $ipprc->filename("TRACE.EXP", $outroot); +# my $source_id = $ipprc->source_id($dbname, $PS_TABLE_ID_STATICSKY); + +my $outbase = basename($outroot); +my ($listFile, $listName) = tempfile("/tmp/$outbase.list.XXXX", UNLINK => !$save_temps ); + +# Get list of input images to stack photometry +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $files; +{ + my $command = "$staticskytool -inputs -sky_id $sky_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform staticskytool -inputs: $error_code", $sky_id, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $sky_id, $PS_EXIT_PROG_ERROR); + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $sky_id, $PS_EXIT_PROG_ERROR); +} + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; + + +# generate the input +print $listFile "INPUT MULTI\n"; +my $nInputs = @$files; + +{ + my $recipe_psphot = $ipprc->reduction($reduction, 'STACKPHOT_PSPHOT'); # Recipe to use for psphot + my $recipe_ppsub = $ipprc->reduction($reduction, 'STACKPHOT_PPSUB'); # Recipe to use for ppsub + my $recipe_ppstack = $ipprc->reduction($reduction, 'STACKPHOT_PPSTACK'); # Recipe to use for ppstack + unless ($recipe_psphot) { + &my_die("Couldn't find selected reduction for STACKPHOT: $reduction\n", $sky_id, $PS_EXIT_CONFIG_ERROR); + } + + print "reduction: $reduction\n"; + print "recipe_psphot: $recipe_psphot\n"; + print "recipe_ppsub: $recipe_ppsub\n"; + print "recipe_ppstack: $recipe_ppstack\n"; + my $configuration = $ipprc->filename("PSPHOT.STACK.CONFIG", $outroot); + + # XXX this script and psphotStack use the recipe file inconsistently: + # XXX psphotStack respects the value of PSPHOT.STACK.USE.RAW from the config, + # XXX but this script ignores it: if PSPHOT.STACK.USE.RAW is FALSE (needConvolvedImages = 1) + # XXX then psphotStack will expect entries in the input mdc file (CNV:) that this script + # XXX is not supplying. + my $needConvolvedImages = 0; + + foreach my $file (@$files) { + print $listFile "INPUT METADATA\n"; + + # XXX if we take the input from 'warp', we will need to make different selections here + my $path_base = $file->{path_base}; + print "input: $path_base\n"; + my $stack_id = $file->{stack_id}; + + my ($imageCnv, $maskCnv, $weightCnv, $expnumCnv); + if ($needConvolvedImages) { + $imageCnv = $ipprc->filename("PPSTACK.OUTPUT", $path_base ); # Image name + $maskCnv = $ipprc->filename("PPSTACK.OUTPUT.MASK", $path_base ); # Mask name + $weightCnv = $ipprc->filename("PPSTACK.OUTPUT.VARIANCE", $path_base ); # Weight name + $expnumCnv = $ipprc->filename("PPSTACK.OUTPUT.EXPNUM", $path_base ); # Expnum name + } + + my $imageRaw = $ipprc->filename("PPSTACK.UNCONV", $path_base ); # Image name + my $maskRaw = $ipprc->filename("PPSTACK.UNCONV.MASK", $path_base ); # Mask name + my $weightRaw = $ipprc->filename("PPSTACK.UNCONV.VARIANCE", $path_base ); # Weight name + my $expnumRaw = $ipprc->filename("PPSTACK.UNCONV.EXPNUM", $path_base ); # Expnum name + + my $sources; + my ($psfRaw, $backmdlRaw); + if (!$updatemode) { + # sources from stack run. + # XXX: We don't need this file anymore. + $sources = $ipprc->filename("PSPHOT.OUT.CMF.MEF", $path_base ); # Sources name + } else { + # name of output sources from this run when in new state + $require_sources = 1 unless $no_op; + $sources = $ipprc->filename("PSPHOT.STACK.OUTPUT", $outroot, $stack_id); + # During update we rename the sources file to this + my $originalSources = "$sources.original"; + if (!$ipprc->file_exists($originalSources)) { + if ($ipprc->file_exists($sources)) { + unless ($no_op) { + if (!$ipprc->file_rename($sources, $originalSources)) { + &my_die("failed to rename $sources $originalSources", $sky_id, $PS_EXIT_PROG_ERROR); + } + } + } else { + # maybe this should be a fault 2 + &my_die("failed to to find either sources file to update as either $sources or $originalSources", $sky_id, $PS_EXIT_PROG_ERROR); + } + } + $sources = $originalSources; + $psfRaw = $ipprc->filename("PSPHOT.STACK.PSF.SAVE", $outroot, $stack_id); + $backmdlRaw = $ipprc->filename("PSPHOT.STACK.BACKMDL", $outroot, $stack_id); + } + + + # XXX is this the correct PSF file? + my $psfCnv = $ipprc->filename("PPSTACK.TARGET.PSF", $path_base ); # PSF name + + # XXX we could make some different choices if some inputs do not exist... + &my_die("Couldn't find input: $imageRaw", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$imageRaw"); + &my_die("Couldn't find input: $maskRaw", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$maskRaw"); + &my_die("Couldn't find input: $weightRaw", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$weightRaw"); + &my_die("Couldn't find input: $expnumRaw", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$expnumRaw"); + if ($needConvolvedImages) { + &my_die("Couldn't find input: $imageCnv", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$imageCnv"); + &my_die("Couldn't find input: $maskCnv", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$maskCnv"); + &my_die("Couldn't find input: $weightCnv", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$weightCnv"); + &my_die("Couldn't find input: $expnumCnv", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$expnumCnv"); + &my_die("Couldn't find input: $psfCnv", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$psfCnv"); + } + + my $have_sources = $ipprc->file_exists("$sources"); + if ($require_sources) { + &my_die("Couldn't find input: $sources", $sky_id, $PS_EXIT_SYS_ERROR) unless $have_sources; + } + + print $listFile " STACK_ID S64 " . $stack_id . "\n"; + print $listFile " RAW:IMAGE STR " . $imageRaw . "\n"; + print $listFile " RAW:MASK STR " . $maskRaw . "\n"; + print $listFile " RAW:VARIANCE STR " . $weightRaw . "\n"; + print $listFile " RAW:EXPNUM STR " . $expnumRaw . "\n"; + if ($have_sources) { + print $listFile " SOURCES STR " . $sources . "\n"; + } + if ($updatemode) { + &my_die("Couldn't find input: $psfRaw", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$psfRaw"); + &my_die("Couldn't find input: $backmdlRaw", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists("$backmdlRaw"); + print $listFile " RAW:PSF STR " . $psfRaw . "\n"; + print $listFile " RAW:BACKMDL STR " . $backmdlRaw . "\n"; + } + if ($needConvolvedImages) { + print $listFile " CNV:IMAGE STR " . $imageCnv . "\n"; + print $listFile " CNV:MASK STR " . $maskCnv . "\n"; + print $listFile " CNV:VARIANCE STR " . $weightCnv . "\n"; + print $listFile " CNV:EXPNUM STR " . $expnumCnv . "\n"; + print $listFile " CNV:PSF STR " . $psfCnv . "\n"; + } + + print $listFile "END\n\n"; + } + + close $listFile; + + # Perform stack photometry analysis + { + my $command = "$psphotStack $outroot"; + $command .= " -updatemode" if $updatemode; + $command .= " -input $listName"; + $command .= " -threads $threads" if defined $threads; + $command .= " -recipe PSPHOT $recipe_psphot"; + $command .= " -recipe PPSUB $recipe_ppsub"; + $command .= " -recipe PPSTACK $recipe_ppstack"; + $command .= " -dumpconfig $configuration" if !$updatemode; + $command .= " -tracedest $traceDest -log $logDest"; + # $command .= " -dbname $dbname" if defined $dbname; + + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psphotStack: $error_code", $sky_id, $error_code); + } + + # my $outputStatsReal = $ipprc->file_resolve($outputStats); + # &my_die("Couldn't find expected output file: $outputStats", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + + # measure chip stats + # $command = "$ppStatsFromMetadata $outputStatsReal - DIFF_SKYCELL"; + # ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + # run(command => $command, verbose => $verbose); + # unless ($success) { + # $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + # &my_die("Unable to perform ppStatsFromMetadata: $error_code", $sky_id, $error_code); + # } + # foreach my $line (@$stdout_buf) { + # $cmdflags .= " $line"; + # } + # chomp $cmdflags; + + # my ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + + my $quality = 0; + if (!$quality) { + + # Get the output filenames + # we have one set of output files per input file set + for (my $i = 0; $i < @$files; $i++) { + my $stack_id = @$files[$i]->{stack_id}; + my $outputName = $ipprc->filename("PSPHOT.STACK.OUTPUT.IMAGE", $outroot, $stack_id); + my $outputMask = $ipprc->filename("PSPHOT.STACK.OUTPUT.MASK", $outroot, $stack_id); + my $outputVariance = $ipprc->filename("PSPHOT.STACK.OUTPUT.VARIANCE", $outroot, $stack_id); + my $outputSources = $ipprc->filename("PSPHOT.STACK.OUTPUT", $outroot, $stack_id); + + # XXX these are optional and not generated by default + # &my_die("Couldn't find expected output file: $outputName", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputName); + # &my_die("Couldn't find expected output file: $outputMask", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputMask); + # &my_die("Couldn't find expected output file: $outputVariance", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputVariance); + &my_die("Couldn't find expected output file: $outputSources", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputSources); + } + + #my $configuration = $ipprc->filename("PPSUB.CONFIG", $outroot); + #my $outputStats = $ipprc->filename("SKYCELL.STATS", $outroot); + #my $traceDest = $ipprc->filename("TRACE.EXP", $outroot); + + my $chisqName = $ipprc->filename("PSPHOT.CHISQ.IMAGE", $outroot); + my $chisqMask = $ipprc->filename("PSPHOT.CHISQ.MASK", $outroot); + my $chisqVariance = $ipprc->filename("PSPHOT.CHISQ.VARIANCE", $outroot); + + # XXX check the recipe -- should we expect these to exist? + # &my_die("Couldn't find expected output file: $chisqName", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($chisqName); + # &my_die("Couldn't find expected output file: $chisqMask", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($chisqMask); + # &my_die("Couldn't find expected output file: $chisqVariance", $sky_id, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($chisqVariance); + + if (!$updatemode) { + # XXX: should be checking for existence of psf and backmdl output files + } + } + } else { + print "Not executing: $command\n"; + } + } +} + +unless ($no_update) { + + # Add the staticsky result + { + my $command = "$staticskytool -sky_id $sky_id"; + $command .= " -dbname $dbname" if defined $dbname; + if ($updatemode) { + $command .= " -updaterun -set_state full"; + } else { + $command .= " -addresult -path_base $outroot"; + $command .= " -num_inputs $nInputs"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform: $command\n"; + warn($err_message); + exit $error_code; + } + } +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $sky_id = shift; # Diff identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $sky_id and not $no_update) { + + my $command = "$staticskytool -sky_id $sky_id -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + if ($updatemode) { + $command .= " -updateresult"; + } else { + $command .= " -addresult"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -hostname $host" if defined $host; + $command .= " -path_base $outroot" if defined $outroot; + } + run(command => $command, verbose => $verbose); + } + exit $exit_code; +} + +END { + my $exit = $?; + system("sync") == 0 or die "failed to execute sync: $!"; + $? = $exit; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/summit_copy.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/summit_copy.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/summit_copy.pl (revision 41105) @@ -0,0 +1,288 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Config 1.01 qw( :standard ); +use PS::IPP::Metadata::Config; +use Sys::Hostname; + +use Digest::MD5::File qw( file_md5_hex ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +## report the program and machine +my $host = hostname(); +print "\n\n"; +#print "Starting script $0 on $host\n\n"; +my $date = `date`; +print "Starting script $0 on $host at $date"; + + +# Parse the command-line arguments +my ( $uri, $filename, $compress, $bytes, $md5, $nebulous, $summit_id, $exp_name, $inst, $telescope, $class, $class_id, + $dbname, $verbose, $no_update, $no_op, $timeout, $copies ); +GetOptions( + 'uri=s' => \$uri, # source location of file on data store + 'filename=s' => \$filename, # target location of file on local system + 'compress' => \$compress, # request file in compressed format + 'bytes=s' => \$bytes, # reported file size in bytes + 'md5=s' => \$md5, # reported md5 checksum + 'nebulous' => \$nebulous, # use nebulous for the target file + 'summit_id=s' => \$summit_id, # summit_id for this exposure + 'exp_name=s' => \$exp_name, # Exposure name + 'inst=s' => \$inst, # Instrument + 'telescope=s' => \$telescope, # Telescope + 'class=s' => \$class, # Class level + 'class_id=s' => \$class_id, # Class identifier + 'dbname=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'timeout=s' => \$timeout, # passed through to dsget + 'copies=i' => \$copies, # passed through to dsget +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --uri --filename --summit_id --exp_name --inst --telescope --class --class_id", + -exitval => 3) + unless defined $uri + and defined $filename + and defined $summit_id + and defined $exp_name + and defined $inst + and defined $telescope + and defined $class + and defined $class_id; + +# Look for programs we need +my $missing_tools; +my $dsget = can_run('dsget') + or (warn "Can't find dsget" and $missing_tools = 1); +my $pztool = can_run('pztool') + or (warn "Can't find pztool" and $missing_tools = 1); +my $neblocate = can_run('neb-locate') + or (warn "Can't find neb-locate" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $ipprc = PS::IPP::Config->new(); + +# dsget command +my $command; +$command = "$dsget --uri $uri --filename $filename"; +$command .= " --compress" if defined $compress; +$command .= " --bytes $bytes" if defined $bytes; +$command .= " --nebulous" if defined $nebulous; +$command .= " --md5 $md5" if defined $md5; +$command .= " --timeout $timeout" if defined $timeout; +$command .= " --copies $copies" if defined $copies; + +# run command +unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) + = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my_die("Unable to perform dsget: $error_code", + $exp_name, + $inst, + $telescope, + $class, + $class_id, + $uri, + $error_code + ); + } +} else { + print "skipping command: $command\n"; +} + +# +# Find all instances of the new file and make sure they have the +# same checksum and size. +# if so pass the results to pztool to the results in pzDownloadImfile. +# uncomment this to turn on +my ($new_bytes, $new_md5) = check_instances($filename, $nebulous, $compress); + +$date = `date`; +print "starting pztool instances checksum $date"; + +# command to update database +$command = "$pztool -copydone"; +$command .= " -row_lock"; +$command .= " -summit_id $summit_id"; +$command .= " -exp_name $exp_name"; +$command .= " -inst $inst"; +$command .= " -telescope $telescope"; +$command .= " -class $class"; +$command .= " -class_id $class_id"; +$command .= " -uri $filename"; +$command .= " -hostname $host"; +$command .= " -dbname $dbname" if defined $dbname; + +# XXX: TODO: see above. Don't do this until pztool and the DB have +# been updated +$command .= " -md5sum $new_md5 -bytes $new_bytes"; + +# update the database +unless ($no_update) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) + = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform $command: $error_code\n"); + exit($error_code); + } +} else { + print "skipping command: $command\n"; +} + +$date = `date`; +print "finished $date\n"; + + +sub get_file_params +{ + my $filename = shift; + + my $size = -s $filename; + my $md5 = file_md5_hex($filename); + + return ($size, $md5); +} + +sub check_instances { + my $filename = shift; + my $nebulous = shift; + my $compress = shift; + + my @instances; + if ($nebulous) { + my $command = "$neblocate --path --all $filename"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) + = run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my_die("Unable to perform neb-locate: $error_code", + $exp_name, + $inst, + $telescope, + $class, + $class_id, + $uri, + $error_code + ); + } + @instances = split "\n", join "", @$stdout_buf; + } else { + if (!defined $ipprc) { + # we don't usually need this so defer instantaiating it + $ipprc = PS::IPP::Config->new(); + } + my $resolved = $ipprc->file_resolve($filename); + if ($resolved) { + $instances[0] = $resolved; + } + } + if (! scalar @instances) { + my_die("no instances", + $exp_name, + $inst, + $telescope, + $class, + $class_id, + $uri, + $PS_EXIT_UNKNOWN_ERROR + ); + } + + my ($new_bytes, $new_md5) = get_file_params($instances[0]); + + for (my $i = 1; $i < scalar @instances; $i++) { + my ($b, $m) = get_file_params($instances[$i]); + my $error = ""; + if ($b ne $new_bytes) { + $error = "size of $instances[$i] does not match $instances[0]"; + } elsif ($m ne $new_md5) { + $error = "md5sum of $instances[$i] does not match $instances[0]"; + } + if ($error) { + my_die($error, + $exp_name, + $inst, + $telescope, + $class, + $class_id, + $uri, + $PS_EXIT_DATA_ERROR + ); + } + } + + return ($new_bytes, $new_md5); + +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $exp_name = shift; # Chiptool identifier + my $inst = shift; # Chiptool identifier + my $telescope = shift; # Class identifier + my $class = shift; # Class identifier + my $class_id = shift; # Class identifier + my $uri = shift; # Class identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn $msg; + unless ($no_update) { + # command to update database + my $command; + $command = "$pztool -copydone"; + $command .= " -summit_id $summit_id"; + $command .= " -exp_name $exp_name"; + $command .= " -inst $inst"; + $command .= " -telescope $telescope"; + $command .= " -class $class"; + $command .= " -class_id $class_id"; + $command .= " -uri $uri"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + + system ($command); + + if ($exit_code == 110) { + $command = "$pztool -updatepzexp"; + $command .= " -summit_id $summit_id"; + $command .= " -exp_name $exp_name"; + $command .= " -inst $inst"; + $command .= " -telescope $telescope"; + $command .= " -set_state drop"; + $command .= " -dbname $dbname" if defined $dbname; + + system ($command); + } + + } + + exit $exit_code; +} + +# XXX: I don't think that we need this - JH +#END { +# my $status = $?; +# system("sync") == 0 +# or die "failed to execute sync: $!" ; +# $? = $status; +#} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/tdl_generate.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/tdl_generate.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/tdl_generate.pl (revision 41105) @@ -0,0 +1,123 @@ +#!/usr/bin/env perl + +# generate the transient detctions list files for a difference run +# using ipp_mops_translate.pl +# Note: The functionality in this script should probably just be incorporated +# into diff_skycell.pl since all the information needed is aviailable there + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +#print "\n\n"; +#print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); + +use PS::IPP::Config 1.01 qw( :standard ); + +my $ipprc = PS::IPP::Config->new(); # IPP configuration + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Parse the command-line arguments +my ($diff_id, $skycell_id, $outroot, $camera, $dbname, $verbose, $save_temps); + +GetOptions( + 'diff_id=s' => \$diff_id, # Magic identifier + 'skycell_id=s' => \$skycell_id, # skycell_id name + 'camera=s' => \$camera, # Camera name + 'dbname=s' => \$dbname, # Database name + 'outroot=s' => \$outroot, # Output root name + 'save-temps' => \$save_temps, # Save temporary files? + 'verbose' => \$verbose, # Print stuff? + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --diff_id --camera --outroot", + -exitval => 3) unless + defined $diff_id and + defined $camera and + defined $outroot; + +$skycell_id = "" if !defined($skycell_id); + +$ipprc->define_camera($camera); + +# resolve any path:// or file:// in outroot +$outroot = $ipprc->file_resolve($outroot); + +# Look for programs we need +my $missing_tools; +my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); +my $ipp_mops_translate = can_run('ipp_mops_translate.pl') or (warn "Can't find ipp_mops_translate.pl" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +### Get a list of inputs +my $inputs; # List of inputs +{ + my $command = "$difftool -diffskyfile -diff_id $diff_id"; # Command to run + $command .= " -skycell_id $skycell_id" if $skycell_id ne ""; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform difftool -diffskyfile: $error_code", $diff_id, $skycell_id, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $diff_id, $skycell_id, $PS_EXIT_PROG_ERROR); + + $inputs = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $diff_id, $skycell_id, $PS_EXIT_PROG_ERROR); +} + +foreach my $skyfile (@$inputs) { + next if $skyfile->{fault}; + my $path_base = $skyfile->{path_base}; + my $cmf = "${path_base}.cmf"; + my $diff_image_id = $skyfile->{diff_image_id}; + my $basename = basename($path_base); + my $output = "$outroot/${basename}.tdl"; + $skycell_id = $skyfile->{skycell_id}; + my $command = "$ipp_mops_translate --input $cmf --output $output --extname SkyChip.psf --skycell $skyfile->{uri} --diff_image_id $diff_image_id"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $ipp_mops_translate: $error_code", $diff_id, $skycell_id, $error_code); + } + +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $diff_id = shift; # Magic identifier + my $skycell_id = shift; # Node name + my $exit_code = shift; # Exit code to add + + carp($msg); + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/videophot_process.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/videophot_process.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/videophot_process.pl (revision 41105) @@ -0,0 +1,302 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use Data::Dumper; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use File::Temp qw( tempfile ); +use File::Basename qw( basename ); + +# Look for programs we need +my $missing_tools; +my $vptool = can_run('vptool') or (warn "Can't find vptool" and $missing_tools = 1); +my $psvideophot = can_run('psvideophot') or (warn "Can't find psvideophot" and $missing_tools = 1); +my $dumpvideo = can_run('dumpvideo') or (warn "Can't find dumpvideo" and $missing_tools = 1); +my $listvideocells = can_run('listvideocells.pl') or (warn "Can't find listvideocells.pl" and $missing_tools = 1); +my $dsreg = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1); +my $nebrepair = can_run('neb-repair') or (warn "Can't find neb-repair" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} +my ($vp_id, $camera, $outroot, $dest_id, $dbname, $verbose, $no_update, $no_op, $redirect, $save_temps); +my ($product, $save_video_cube, $ds_dbname, $ds_dbhost); + +GetOptions( + 'vp_id=s' => \$vp_id, + 'camera=s' => \$camera, + 'outroot=s' => \$outroot, + 'dest_id=s' => \$dest_id, + 'product=s' => \$product, + 'save-video-cube' => \$save_video_cube, + 'ds_dbname=s' => \$ds_dbname, + 'ds_dbhost=s' => \$ds_dbhost, + 'dbname|d=s' => \$dbname, + 'verbose' => \$verbose, + 'save-temps' => \$save_temps, + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, # redirect output streams to logfile +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --vp_id --outroot --camera", + -exitval => 3, + ) unless defined $vp_id + and defined $camera + and defined $outroot; + +pod2usage( + -msg => " --product -ds_dbname and --dsdbhost are required if --dest_id", + -exitval => 3, + ) if ($dest_id and !( defined $product and defined $ds_dbname and defined $ds_dbhost)); + + +$no_update = 1 if $no_op; +$vptool .= " -dbname $dbname" if $dbname; + +my $ipprc = PS::IPP::Config->new($camera) or my_die( "Unable to set up", $vp_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my $logDest = $ipprc->filename("LOG.EXP", $outroot); +if ($redirect) { + $ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $vp_id, $PS_EXIT_SYS_ERROR ); + + print "\n\n"; + print "Starting script $0 on $host at $date\n\n"; +} + +# Get list of chips with pending video cells +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $files; +{ + my $command = "$vptool -pendingimfile -vp_id $vp_id"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform vptool -pendingimfile: $error_code", $vp_id, $error_code); + } + + my $output = join "", @$stdout_buf; + if ($output) { + my $metadata = $mdcParser->parse($output) or + &my_die("Unable to parse metadata config doc", $vp_id, $PS_EXIT_PROG_ERROR); + $files = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $vp_id, $PS_EXIT_PROG_ERROR); + } +} + + +foreach my $file (@$files) { + my $class_id = $file->{class_id}; + my $uri = $file->{uri}; + + my $resolved = $ipprc->file_resolve($uri); + &my_die("Unable to resolve $uri", $vp_id, $PS_EXIT_UNKNOWN_ERROR) unless $resolved; + + my $command = "$listvideocells --file $resolved"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + check_input_file($uri, $vp_id, $class_id, 'nocell'); + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command: $error_code", $vp_id, $error_code); + } + + my @video_cells = split "\n", (join "", @$stdout_buf); + &my_die("No video cells found in $uri", $vp_id, $PS_EXIT_UNKNOWN_ERROR) unless scalar @video_cells; + + foreach my $cell_id (@video_cells) { + my $path_base = "$outroot.$class_id.$cell_id"; + my $error; + my $output = $ipprc->prepare_output("PSVIDEOPHOT.OUTPUT", $path_base, undef, 1, \$error) + or &my_die("failed to prepare output file for PSVIDEOPHOT.OUTPUT", $vp_id, $error); + my $command = "$psvideophot $output"; + $command .= " -file $uri"; + $command .= " -class_id $class_id"; + $command .= " -cell_id $cell_id"; + my $vpstart = DateTime->now->mjd; + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform psvideophot: $error_code", $vp_id, $error_code); + } + } else { + print "Not executing: $command\n"; + } + # dump the video cell and the video table to a file + if ($save_video_cube) { + my $output = $path_base . ".fits"; + my $extname = "$cell_id"; + my $command = "$dumpvideo $uri $extname $output -includetable"; + unless ($no_op) { + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform dumpvideo: $error_code", $vp_id, $error_code); + } + } else { + print "Not executing: $command\n"; + } + } + + unless ($no_update) { + my $command = "$vptool -addprocessedcell -vp_id $vp_id -class_id $class_id -cell_id $cell_id"; + $command .= " -path_base $path_base"; + $command .= " -hostname $host"; + $command .= " -dtime_photom " . ((DateTime->now->mjd - $vpstart) * 86400); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform vptool -addvpcell"; + &my_die("$err_message: $error_code", $vp_id, $error_code); + } + } + } +} +if ($dest_id) { + my $command = "$vptool -processedcell -vp_id $vp_id"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform vptool -pendingimfile: $error_code", $vp_id, $error_code); + } + + my $output = join "", @$stdout_buf; + my $cells; + if ($output) { + my $metadata = $mdcParser->parse($output) or + &my_die("Unable to parse metadata config doc", $vp_id, $PS_EXIT_PROG_ERROR); + $cells = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $vp_id, $PS_EXIT_PROG_ERROR); + } + my ($reglist, $reglistName) = tempfile("/tmp/filelist.$vp_id.XXXX", UNLINK => !$save_temps); + + if ($redirect) { + print $reglist "$logDest|||text|\n"; + } + # list of extensions and types for files to distribute + my @exts = qw( vpt ); + my @types = qw( table ); + if ($save_video_cube) { + push @exts, 'fits'; + push @types, 'fits'; + } + foreach my $cell (@$cells) { + my $path_base = $cell->{path_base}; + for (my $i = 0; $i < scalar @exts; $i++) { + my $file = "$path_base.$exts[$i]"; + my $type = $types[$i]; + + print $reglist "$file|||$type|\n"; + } + } + close $reglist or &my_die("failed to close $reglistName", $vp_id, $PS_EXIT_UNKNOWN_ERROR); + unless ($no_update or $no_op) { + my $fileset = basename($outroot); + my $command = "$dsreg --add $fileset --product $product --type dump --list $reglistName"; + $command .= " --abspath --link"; + $command .= " --dbname $ds_dbname --dbhost $ds_dbhost"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform $command error_code: $error_code", $vp_id, $error_code); + } + } +} + +unless ($no_update) { + my $command = "$vptool -updaterun -vp_id $vp_id -set_state full"; + $command .= " -set_outroot $outroot"; + $command .= " -set_hostname $host"; + $command .= " -set_dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform vptool -updaterun"; + &my_die("$err_message: $error_code", $vp_id, $error_code); + } +} + +exit 0; + +sub check_input_file { + my $uri = shift; + my $vp_id = shift; + my $class_id = shift; + my $cell_id = shift; + my $resolved = $ipprc->file_resolve($uri); + + my $tryrepair = 0; + if (!-e $resolved) { + printf STDERR "instance $resolved for $uri does not exist\n"; + $tryrepair = 1; + } elsif (-s $resolved == 0) { + printf STDERR "instance $resolved for $uri is empty\n"; + $tryrepair = 1; + } + if ($tryrepair) { + my $scheme = file_scheme($uri); + if ($scheme and ($scheme = 'neb')) { + my $command = "$nebrepair $uri"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + my $err_message = "Unable to perform nebrepair"; + &my_die("$err_message: $error_code", $vp_id, $error_code); + } + } + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $vp_id = shift; # vpRun id + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $vp_id and not $no_update) { + my $command = "$vptool -vp_id $vp_id"; + $command .= " -updaterun"; + $command .= " -set_fault $exit_code"; + $command .= " -set_hostname $host" if defined $host; + $command .= " -set_outroot $outroot" if defined $outroot; + $command .= " -set_dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400); + + run(command => $command, verbose => $verbose); + } + exit $exit_code; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/warp_overlap.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/warp_overlap.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/warp_overlap.pl (revision 41105) @@ -0,0 +1,315 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use File::Temp qw( tempfile ); +use File::Spec; +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Look for programs we need +my $missing_tools; +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $dvoImageOverlaps = can_run('dvoImageOverlaps') or (warn "Can't find dvoImageOverlaps" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($warp_id, $camera, $tess_dir, $dbname, $verbose, $no_update, $no_op, $logfile, $save_temps); +GetOptions( + 'warp_id|i=s' => \$warp_id, # Warp identifier + 'camera|c=s' => \$camera, # Camera name + 'tess_dir=s' => \$tess_dir, # Tessellation directory + 'dbname|d=s' => \$dbname, # Database name + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations + 'logfile=s' => \$logfile, + 'save-temps' => \$save_temps, # Save temporary files? +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --warp_id --camera --tess_dir", + -exitval => 3, +) unless defined $warp_id + and defined $camera + and defined $tess_dir; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $warp_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration +$ipprc->redirect_to_logfile($logfile) or my_die( "Unable to redirect output", $warp_id, $PS_EXIT_SYS_ERROR ) if $logfile; + +&my_die("Tessellation identifier not provided: $tess_dir", $warp_id, $PS_EXIT_SYS_ERROR) unless $tess_dir ne "NULL"; + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Get list of component imfiles for exposure +my $imfiles; +{ + my $command = "$warptool -imfile -warp_id $warp_id"; + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool -imfile: $error_code", $warp_id, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $warp_id, $PS_EXIT_PROG_ERROR); + $imfiles = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $warp_id, $PS_EXIT_PROG_ERROR); +} + +# Where do we get the astrometry source from? +my $astromSource; # The astrometry source filerule (eg, PSASTRO.OUTPUT, PSASTRO.OUTPUT.MEF) +my $astromAccept; # Accept the astrometry unconditionally? +{ + my $command = "$ppConfigDump -camera $camera -dump-recipe PSWARP -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $warp_id, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $warp_id, $PS_EXIT_PROG_ERROR); + $astromSource = metadataLookupStr($metadata, 'ASTROM.SOURCE'); + $astromAccept = metadataLookupBool($metadata, 'ASTROM.ACCEPT'); +} + +# Determine the imfile/skycell overlaps +my @overlaps = (); +unless ($no_op) { + # Calculate the overlaps between imfiles and skycells + + # tess_dir is the DVO db holding the tessalations + # this may be an abstract name in site.config:TESSELLATIONS, a URI, or an absolute path. + # convert this to an absolute path + my $tess_dir_abs = $ipprc->tessellation_catdir( $tess_dir ); # Tessellation catdir for DVO + $tess_dir_abs = $ipprc->convert_filename_absolute( $tess_dir_abs ); + + my %unique_skycells = (); # Identified skycells (all unique by virtue of hash property) + + # astrometry is always determined at the camera stage; we have a MEF astrometry file from psastro + my $imfile = $imfiles->[0]; + my $camRoot = $imfile->{cam_path_base}; + my $astromFile = $ipprc->filename($astromSource, $camRoot); # Astrometry file + if (!$astromFile) { + &my_die("Unable to determine the astrometry source", $warp_id, $PS_EXIT_DATA_ERROR); + } + $astromFile = $ipprc->file_resolve($astromFile); + if (!$astromFile) { + &my_die("Unable to resolve real astrometry source filename", $warp_id, $PS_EXIT_DATA_ERROR); + } + + my @matchlist = get_overlaps($astromFile, $tess_dir_abs, $astromAccept); # List of overlaps + if (! @matchlist) { + &my_die("Unable to perform dvoImageOverlaps: missing astrometry", $warp_id, $PS_EXIT_DATA_ERROR); + } + # Match each of the imfiles to this list (the input images may be split, but the astrometry is not) + # tess_dir (not tess_dir_abs) is supplied here so it may be written to the db + foreach my $imfile (@$imfiles) { + extract_overlaps(\@matchlist, $imfile, $astromFile, $tess_dir, \@overlaps, \%unique_skycells); + } +} else { + # create an overlap with an entry for each skycell:imfile match + foreach my $imfile (@$imfiles) { + my %overlap = (); + $overlap{skycell_id} = 'default'; + $overlap{tess_dir} = 'default'; + $overlap{cam_id} = $imfile->{cam_id}; + $overlap{class_id} = $imfile->{class_id}; + $overlap{fault} = $imfile->{fault}; + push @overlaps, \%overlap; + } +} + +# If no overlaps are found, we +# keep running this step over and over (a successful warptool -addoverlap prevents +# successive warptime -imfile from running. +&my_die("Unable to find any overlaps", $warp_id, $PS_EXIT_PROG_ERROR) if scalar @overlaps == 0; + +# Generate a MDC file with the overlaps +my ($overlapFile, $overlapName) = tempfile( "/tmp/overlaps.wrp.$warp_id.mdc.XXXX", UNLINK => !$save_temps ); +print $overlapFile "warpSkyCellMap MULTI\n\n"; +foreach my $overlap (@overlaps) { + print $overlapFile "warpSkyCellMap METADATA\n"; + print $overlapFile " warp_id S32 $warp_id\n"; + print $overlapFile " skycell_id STR $overlap->{skycell_id}\n"; + # XXX convert tess_id here to tess_dir when db scheme is updated + print $overlapFile " tess_id STR $overlap->{tess_dir}\n"; + print $overlapFile " cam_id S32 $overlap->{cam_id}\n"; + print $overlapFile " class_id STR $overlap->{class_id}\n"; + print $overlapFile " fault S16 $overlap->{fault}\n"; + print $overlapFile "END\n\n"; +} +close $overlapFile; + +system "cat $overlapName" if $verbose; + +# Add the processed file to the database +unless ($no_update) { + my $command = "$warptool -addoverlap -mapfile $overlapName"; # Command to run warptool + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform warptool -addoverlap: $error_code\n"); + exit($error_code); + } +} + +sub my_die +{ + my $msg = shift; # Warning message on die + my $warp_id = shift; # Warp identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + if (defined $warp_id and not $no_update) { + my $command = "$warptool -addoverlap"; + $command .= " -warp_id $warp_id"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + system ($command); + } + exit $exit_code; +} + +# Run dvoImageOverlaps to get the overlaps; return the output +sub get_overlaps +{ + my $filename = shift; # Filename on which to run dvoImageOverlaps + my $tess_dir_abs = shift; # Tessellation directory + my $accept = shift; # Do we use the -accept-astrom flag? + + my $command = "$dvoImageOverlaps -D CATDIR $tess_dir_abs " . $filename; + $command .= ' -accept-astrom' if $accept; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + if (!$success) { + print "Unable to calculate overlaps from $filename\n"; + print "STDOUT:\n"; + foreach my $line (@$stdout_buf) { + print ">>>$line"; + } + print "STDERR:\n"; + foreach my $line (@$stderr_buf) { + print ">>>$line"; + } + return 0; + } + return split ('\n', (join "", @$stdout_buf)); +} + +# Extract a list of overlaps for an imfile +# +# The command "dvoImageOverlaps FILENAME" returns: +# FILENAME[HDU] : SKYCELL.ID +# eg: 729534pa.cmf[ccd00.hdr] : skycell.051.fits +# for the case of split data, we need to identify the input imfiles based on this information +sub extract_overlaps +{ + my $matches = shift; # Reference to list of skycells from dvoImageOverlaps + my $imfile = shift; # Imfile information + my $filename = shift; # Filename used with dvoImageOverlaps + my $tess_dir = shift; # Tessellation identifier + my $overlaps = shift; # Reference to list of overlaps + my $unique_skycells = shift; # Reference to hash of found skycells + + # Get rid of the path + my @dirlist = File::Spec->splitdir( $filename ); # The elements of the full path + $filename = pop @dirlist; + + # Work out how to identify this imfile in the output + my $fileLevel = $imfile->{filelevel}; + my $entry; # How to identify this imfile in the dvoImageOverlaps output + + if (lc($fileLevel) eq "chip") { + # in the case of SPLIT images, all CLASSes are included in the output list + # we need to pull out the single CLASS_ID for this imfile from the full list + my $class_id = $imfile->{class_id}; + my $chipRoot = $imfile->{chip_path_base}; + my $extname = $ipprc->extname_rule("CMF.HEAD", $class_id); # MEF psastro output + + $entry = $filename . '\[' . $extname . '\]'; + print STDERR "entry: $entry, class: $class_id, extname: $extname, chiproot: $chipRoot\n" if $verbose; + } else { + # in the case of MEF or SINGLE images, there is only a single CLASS in the output list + $entry = $filename; + print STDERR "entry: $entry\n" if $verbose; + } + + my @skycells = &select_skycells($entry, @$matches); # Matching skycells + my $Nskycells = @skycells; + printf STDERR "Nskycells: $Nskycells\n" if $verbose; + foreach my $skycell (@skycells) { + my %overlap = (); # Overlap information for warptool + $overlap{skycell_id} = $skycell; + $overlap{tess_dir} = $tess_dir; + $overlap{cam_id} = $imfile->{cam_id}; + $overlap{class_id} = $imfile->{class_id}; + $overlap{fault} = $imfile->{fault}; + push @$overlaps, \%overlap; + + printf STDERR "overlap: %s : %s , %s\n", $skycell, $imfile->{cam_id}, $imfile->{class_id} if $verbose; + + $unique_skycells->{$skycell} = 1; + } + + return; +} + +# Find skycells in the list that come from a particular entry +sub select_skycells +{ + my $entry = shift; # File+Ext to search for + my @list = @_; # List of "File+Ext : skycell" + + my @skycells = (); + my %unique = (); # Ensure we only return unique skycells for this entry + + foreach my $line (@list) { + if ($line =~ m|$entry|) { + my ($skycell) = $line =~ m|$entry\S*\s+:\s+(\S+)|; + if (not defined $unique{$skycell}) { + push @skycells, $skycell; + $unique{$skycell} = 1; + } + } + } + return @skycells; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/warp_skycell.pl =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/warp_skycell.pl (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/warp_skycell.pl (revision 41105) @@ -0,0 +1,592 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +## report the program and machine +use Sys::Hostname; +my $host = hostname(); +my $date = `date`; +print "\n\n"; +print "Starting script $0 on $host at $date\n\n"; + +use DateTime; +my $mjd_start = DateTime->now->mjd; # MJD of starting script + +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use IPC::Cmd 0.36 qw( can_run run ); +use File::Spec; +use File::Temp qw( tempfile ); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +# Look for programs we need +my $missing_tools; +my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); +my $pswarp = can_run('pswarp') or (warn "Can't find pswarp" and $missing_tools = 1); +my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); +my $ppStatsFromMetadata = can_run('ppStatsFromMetadata') or (warn "Can't find ppStatsFromMetadata" and $missing_tools = 1); +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +my ($warp_id, $skycell_id, $warp_skyfile_id, $tess_dir, $reduction, $camera, $dbname, $outroot, $threads, $run_state, $magicked, $verbose, $no_update, $no_op, $redirect, $save_temps); + +GetOptions( + 'warp_id|i=s' => \$warp_id, # Warp identifier + 'skycell_id|s=s' => \$skycell_id, # Skycell identifier + 'warp_skyfile_id|s=s' => \$warp_skyfile_id, # Unique file identifier + 'tess_dir|s=s' => \$tess_dir, # Tesselation identifier + 'camera|c=s' => \$camera, # Camera name + 'dbname|d=s' => \$dbname, # Database name + 'reduction=s' => \$reduction, # Reduction class + 'outroot=s' => \$outroot, # Output root name + 'threads=s' => \$threads, # Number of threads to use for pswarp + 'run-state=s' => \$run_state, # 'new' or 'update' + 'magicked=s' => \$magicked, # input run has been magicked already? + 'verbose' => \$verbose, # Print to stdout + 'no-update' => \$no_update, # Don't update the database? + 'no-op' => \$no_op, # Don't do any operations? + 'redirect-output' => \$redirect, + 'save-temps' => \$save_temps, # Save temporary files? +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( + -msg => "Required options: --warp_id --warp_skyfile_id --skycell_id --tess_dir --camera --outroot --run-state", + -exitval => 3, +) unless defined $warp_id + and defined $skycell_id + and defined $warp_skyfile_id + and defined $tess_dir + and defined $camera + and defined $outroot + and defined $run_state; + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_CONFIG_ERROR ); # IPP configuration + +my ($logDest, $traceDest); +my $do_stats; +if ($run_state eq 'new') { + $logDest = $ipprc->filename("LOG.EXP", $outroot, $skycell_id); + $traceDest = prepare_output("TRACE.EXP", $outroot, $skycell_id, 1); + $do_stats = 1; +} elsif ($run_state eq 'update') { + $logDest = $ipprc->filename("LOG.EXP.UPDATE", $outroot, $skycell_id); + $traceDest = prepare_output("TRACE.EXP.UPDATE", $outroot, $skycell_id, 1); +} else { + &my_die( "invalid run_state: $run_state", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_CONFIG_ERROR ); +} + +my $neb; +my $scheme = file_scheme($outroot); +if ($scheme and $scheme eq 'neb') { + $neb = $ipprc->nebulous(); +} + +$ipprc->redirect_to_logfile($logDest) or my_die( "Unable to redirect output", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR ) if $redirect; + +# Recipes to use based on reduction class +$reduction = 'DEFAULT' unless defined $reduction; +my $recipe_pswarp = $ipprc->reduction($reduction, 'WARP_PSWARP'); # Recipe to use +my $recipe_psastro = $ipprc->reduction($reduction, 'PSASTRO'); # Recipe to use +unless ($recipe_pswarp and $recipe_psastro) { + &my_die("Couldn't find selected reduction: $reduction\n", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_CONFIG_ERROR); +} + +my $source_id = $ipprc->source_id($dbname, $PS_TABLE_ID_WARP); + +# Get list of component imfiles for exposure +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files +my $imfiles; +{ + # XXX change -tess_id to -tess_dir when db schema is updated + my $command = "$warptool -scmap"; + $command .= " -warp_id $warp_id"; + $command .= " -skycell_id $skycell_id"; + # $command .= " -tess_id $tess_dir"; XXX I don't think this is necessary or useful + $command .= " -dbname $dbname" if defined $dbname; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform warptool -scmap: $error_code", $warp_id, $skycell_id, $tess_dir, $error_code); + } + + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_PROG_ERROR); + $imfiles = parse_md_list($metadata) or + &my_die("Unable to parse metadata list", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_PROG_ERROR); +} + +# Where do we get the astrometry source from? +my $astromSource; # The astrometry source +my $doBackground; # Do we want to make background models? +my $noCompression; +{ + my $command = "$ppConfigDump -camera $camera -recipe PSWARP $recipe_pswarp -dump-recipe PSWARP -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $warp_id, $skycell_id, $tess_dir, $error_code); + } + my $metadata = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_PROG_ERROR); + $astromSource = metadataLookupStr($metadata, 'ASTROM.SOURCE'); + $doBackground = metadataLookupBool($metadata, 'BACKGROUND.MODEL'); + $noCompression = metadataLookupBool($metadata, 'NO.COMPRESS'); +} + +my $dynamicMasks; # Use dynamic masks? +{ + # Get the PSASTRO recipe + my $command = "$ppConfigDump -camera $camera -recipe PSASTRO $recipe_psastro -dump-recipe PSASTRO -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $warp_id, $PS_EXIT_CONFIG_ERROR); + } + my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $warp_id, $PS_EXIT_CONFIG_ERROR); + + $dynamicMasks = metadataLookupBool($recipeData, 'REFSTAR_MASK'); +} +print "Dynamic Mask Status: $dynamicMasks\n"; + +my $outputImage = prepare_output ("PSWARP.OUTPUT", $outroot, $skycell_id, 1); +my $outputMask = prepare_output ("PSWARP.OUTPUT.MASK", $outroot, $skycell_id, 1); +my $outputWeight = prepare_output ("PSWARP.OUTPUT.VARIANCE", $outroot, $skycell_id, 1); +my $outputSources = prepare_output ("PSWARP.OUTPUT.SOURCES", $outroot, $skycell_id, 1); +my $outputPSF = prepare_output ("PSPHOT.PSF.SKY.SAVE", $outroot, $skycell_id, 1); +my $outputBin1 = prepare_output ("PSWARP.BIN1", $outroot, $skycell_id, 1); +my $outputBin2 = prepare_output ("PSWARP.BIN2", $outroot, $skycell_id, 1); +my $outputStats; +if ($do_stats) { + $outputStats = prepare_output ("SKYCELL.STATS", $outroot, $skycell_id, 1) if $do_stats; +} +my $outputBKGs; +if ($doBackground) { + $outputBKGs = prepare_output ("PSWARP.OUTPUT.BKGMODEL", $outroot, $skycell_id, 1); +} +my $configuration; + +my $dump_config = 1; +if ($run_state eq 'new') { + $configuration = prepare_output ("PSWARP.CONFIG", $outroot, $skycell_id, 1); +} else { + $configuration = $ipprc->filename("PSWARP.CONFIG", $outroot, $skycell_id) or + &my_die("Missing entry from camera config PSWARP.CONFIG", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_CONFIG_ERROR); + if ($ipprc->file_exists($configuration)) { + $dump_config = 0; + } else { + print STDERR "WARNING: Config dump file $configuration is missing. Using current recipes and file rules.\n"; + + # XXX: should we create a new config dump file? + # I vote yes but only if we can distingusing between temporarily unavailable and GONE. + my $gone = 0; + if (storage_object_exists($configuration, \$gone)) { + if ($gone) { + $configuration = prepare_output('PSWARP.CONFIG', $outroot, $skycell_id, 1); + # if we dump the config we need to insure that the config dump represents + # the full processing + } else { + # file is temporarily not available. Don't dump config. + $dump_config = 0; + } + } + } +} + + +my $skyFile = prepare_output ("SKYCELL.TEMPLATE", $outroot, $skycell_id, 1); +$ipprc->skycell_file( $tess_dir, $skycell_id, $skyFile, $verbose ) or &my_die("Unable to generate template skycell", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR); +## XXX this seems to have insufficient error checking: dvoImageExtract can fail to write and still return a valid exit status + +# Get list of filenames +my $tempOutRoot = "/tmp/warp.$camera.$warp_id.$skycell_id"; +my ($imageFile, $imageName) = tempfile( "$tempOutRoot.image.list.XXXX", UNLINK => !$save_temps); +my ($maskFile, $maskName) = tempfile( "$tempOutRoot.mask.list.XXXX", UNLINK => !$save_temps); +my ($weightFile, $weightName) = tempfile( "$tempOutRoot.weight.list.XXXX", UNLINK => !$save_temps); +my ($astromFile, $astromName) = tempfile( "$tempOutRoot.astrom.list.XXXX", UNLINK => !$save_temps); +my ($bkgFile, $bkgName); +if ($doBackground) { + ($bkgFile, $bkgName) = tempfile( "$tempOutRoot.bkg.list.XXXX", UNLINK => !$save_temps); +} +my $wrote_astrom = 0; +foreach my $imfile (@$imfiles) { + my $image = $ipprc->filename ("PPIMAGE.CHIP", $imfile->{chip_path_base}, $imfile->{class_id}); # Image name + my $weight = $ipprc->filename ("PPIMAGE.CHIP.VARIANCE", $imfile->{chip_path_base}, $imfile->{class_id}); # Mask name + + my $mask; # Mask name + if ($dynamicMasks) { + $mask = $ipprc->filename ("PSASTRO.OUTPUT.MASK", $imfile->{cam_path_base}, $imfile->{class_id}); + } else { + $mask = $ipprc->filename ("PPIMAGE.CHIP.MASK", $imfile->{chip_path_base}, $imfile->{class_id}); + } + + &my_die("Couldn't find input file: $image", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($image); + &my_die("Couldn't find input file: $weight", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($weight); + &my_die("Couldn't find input file: $mask", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($mask); + + # Astrometry file: astrometry is done at the camera stage, and always results in a MEF file + # XXX allow an option to use the image header astrometry? + my $astrom = $ipprc->filename ($astromSource, $imfile->{cam_path_base}); + + &my_die("Couldn't find input file: $astrom", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR) unless defined $astrom and $ipprc->file_exists($astrom); + + print $imageFile "$image\n"; + print $maskFile "$mask\n"; + print $weightFile "$weight\n"; + my $bkg; + if (($doBackground)) { + # &&($imfile->{background_model} == 1) + if (($imfile->{cam_background_model})&&($imfile->{cam_background_model} != 32767)) { + $bkg = $ipprc->filename("PPIMAGE.BACKMDL", $imfile->{cam_path_base}, $imfile->{class_id}); + } + else { + $bkg = $ipprc->filename("PPIMAGE.BACKMDL", $imfile->{chip_path_base}, $imfile->{class_id}); + } + print $bkgFile "$bkg\n"; + } + + if (!$wrote_astrom) { + print $astromFile "$astrom\n"; + $wrote_astrom = 1; + } +} +close $imageFile; +close $maskFile; +close $weightFile; +close $astromFile; +if ($doBackground) { + close($bkgFile); +} +# We need the recipe to determine if we care whether the PSF is generated or not +my $recipe; +{ + my $command = "$ppConfigDump -camera $camera -dump-recipe PSWARP -recipe PSWARP $recipe_pswarp -"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppConfigDump: $error_code", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR); + } + $recipe = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse metadata config doc", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR); +} + + +# Run pswarp +my $cmdflags; +unless ($no_op) { + my $command = "$pswarp"; + $command .= " -list $imageName"; + $command .= " -masklist $maskName"; + $command .= " -variancelist $weightName"; + $command .= " -astromlist $astromName"; + $command .= " -bkglist $bkgName" if ($doBackground); + $command .= " $outroot $skyFile"; + $command .= " -F PSPHOT.PSF.SAVE PSPHOT.PSF.SKY.SAVE"; + $command .= " -F PSPHOT.OUTPUT PSPHOT.OUT.CMF.MEF"; + $command .= " -F PSPHOT.BACKMDL PSPHOT.BACKMDL.MEF"; + $command .= " -F SOURCE.PLOT.MOMENTS SOURCE.PLOT.SKY.MOMENTS"; + $command .= " -F SOURCE.PLOT.PSFMODEL SOURCE.PLOT.SKY.PSFMODEL"; + $command .= " -F SOURCE.PLOT.APRESID SOURCE.PLOT.SKY.APRESID"; + $command .= " -R PSWARP.OUTPUT FITS.TYPE NONE" if $noCompression; + $command .= " -recipe PSWARP $recipe_pswarp"; + $command .= " -tracedest $traceDest -log $logDest"; + $command .= " -threads $threads" if defined $threads; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " -image_id $warp_skyfile_id" if defined $warp_skyfile_id; + $command .= " -source_id $source_id" if defined $source_id; + if ($run_state eq 'new') { + $command .= " -dumpconfig $configuration"; + } else { + $command .= " -ipprc $configuration"; + } + if ($do_stats) { + $command .= " -recipe PPSTATS WARPSTATS"; + $command .= " -stats $outputStats"; + } + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform pswarp: $error_code", $warp_id, $skycell_id, $tess_dir, $error_code); + } + + if ($do_stats) { + # Check first for the stats file + check_output($outputStats, 0); + my $outputStatsReal = $ipprc->file_resolve($outputStats); +# &my_die("Couldn't find expected output file: $outputStats", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($outputStatsReal); + &my_die("Stats file has zero size: $outputStats", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR) unless -s $outputStatsReal; + + # measure skycell stats + $command = "$ppStatsFromMetadata $outputStatsReal - WARP_SKYCELL"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + my ($quality) = $cmdflags =~ /-quality (\d+)/; # Quality flag + + if (!$quality) { + check_output($outputImage, 0); + check_output($outputMask, 0); + check_output($outputWeight, 0); + check_output($outputSources, 1); + check_output($outputPSF, 1) if metadataLookupBool($recipe, 'PSF') ; + if ($dump_config) { + check_output($configuration, 1); + } + } + print "Quality: $quality\n"; + unless ($no_update) { + # XXX change -tess_id to -tess_dir when db is updated + my $command = "$warptool -addwarped"; + $command .= " -warp_id $warp_id"; + $command .= " -skycell_id $skycell_id"; + $command .= " -tess_id $tess_dir"; + $command .= " -path_base $outroot"; # needed for logfile lookups + $command .= " -set_magicked $magicked" if $magicked; + + $command .= " -uri $outputImage" if !$quality; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " $cmdflags"; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform warptool -addwarped: $error_code\n"); + exit($error_code); + } + } + } else { + + my $quality = 0; + + unless ($ipprc->file_exists($outputPSF)) { + $quality = 8006; # bad data. + } + print "Quality: $quality\n"; + if (!$quality) { + check_output($outputImage, 0); + check_output($outputMask, 0); + check_output($outputWeight, 0); + check_output($outputSources, 0); + check_output($outputPSF, 0) if metadataLookupBool($recipe, 'PSF') ; + } + + # $run_state eq 'update' + unless ($no_update) { + my $try = 0; + while (1) { + $try++; + my $command = "$warptool -tofullskyfile"; + $command .= " -warp_id $warp_id"; + $command .= " -skycell_id $skycell_id"; + $command .= " -set_magicked $magicked" if $magicked; + $command .= " -set_quality $quality" if $quality; + $command .= " -dbname $dbname" if defined $dbname; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + warn("Unable to perform warptool -tofullskyfile: $error_code\n"); + exit($error_code) if $try >= 2; + sleep 10; + warn("Trying again\n"); + } else { + last; + } + } + } + } +} + +exit 0; + +# Prepare to write to an output file +# Lookup the filename in the rules. +# Make sure that if file exists and is a nebulous file that there is only one instance +# Deal with files that have been lost. +sub prepare_output +{ + my $filerule = shift; + my $outroot = shift; + my $skycell_id = shift; + my $delete = shift; + $delete = 0 if !defined $delete; + + my $error; + my $output = $ipprc->prepare_output($filerule, $outroot, $skycell_id, $delete, \$error) + or &my_die("failed to prepare output file for: $filerule", $warp_id, $skycell_id, $tess_dir, $error); + return $output; +} + +sub check_output +{ + my $file = shift; + my $replicate = shift; + + if (!defined $file) { + return; + } + + &my_die("Couldn't find expected output file: $file", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR) unless $ipprc->file_exists($file); + + # Funpack to confirm we've really made things correctly + my $diskfile = $ipprc->file_resolve($file); + if ($diskfile =~ /fits/) { + my $funpack = can_run('funpack') or &my_die ("Can't find funpack", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR); + my $check_command = "$funpack -S $diskfile > /dev/null"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $check_command, verbose => $verbose); + if (!$success) { + &my_die("Output file not a valid fits file: $file", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR); + } + } + ##### + + if ($replicate and $neb) { + $ipprc->replicate_file($file) or &my_die("failed to replicate: $file\n", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_SYS_ERROR); + } +} + +# subroutine to check the status of a nebulous file. Used to distinguish between a storage object that +# does not exist and one that all of the instances have been lost. +# XXXX This should be implemented properly in Nebulous +# For now uses Bill's script 'whichnode' which queries the nebulous database directly + +my $whichnode; +sub storage_object_exists +{ + return 0 if !$neb; + + my $file = shift; + my $ref_all_gone = shift; + + my $exists = $neb->storage_object_exists($file); + if (!$exists) { + return 0; + } + + if (!$whichnode) { + $whichnode = can_run('whichnode') or + &my_die("Can't find whichnode", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_CONFIG_ERROR); + } + + my $command = "$whichnode $file"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform whichnode: $error_code", $warp_id, $skycell_id, $tess_dir, $PS_EXIT_CONFIG_ERROR); + } + + my @lines = split "\n", (join "", @$stdout_buf); + + if (scalar @lines == 0) { + # no output the file is really and truely gone + # XXX: this is now caught above + print STDERR "storage object for $file does not exist\n"; + return 0; + } + + my $numGone = 0; + my $numNotGone = 0; + foreach my $line (@lines) { + chomp $line; + + # output lines are either + # "volume available" + # or + # "volume not available" + + my ($volume, $answer, undef) = split " ", $line; + # our hack is if the volume has an X in the name it's gone + if ($volume =~ /X/) { + print STDERR "$file is on $volume which is gone\n"; + $numGone++; + } elsif ($answer eq 'available') { + $numNotGone++; + } elsif ($answer eq 'not') { + print STDERR "$file is on $volume which is not available\n"; + $numNotGone++; + } else { + print STDERR "unexpected output from whichnode: $line\n"; + } + } + # if there are any instances that are not on a gone volume set all_gone to 0 + if ($numNotGone == 0 and $numGone > 0) { + $$ref_all_gone = 1; + } else { + $$ref_all_gone = 0; + } + + # storage object exists so return true + return 1; +} + + +sub my_die +{ + my $msg = shift; # Warning message on die + my $warp_id = shift; # Warp identifier + my $skycell_id = shift; # Skycell identifier + my $tess_dir = shift; # Tesselation identifier + my $exit_code = shift; # Exit code to add + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + warn($msg); + if (defined $warp_id and defined $skycell_id and defined $tess_dir and not $no_update) { + # XXX change -tess_id to -tess_dir when db is updated + my $command = "$warptool"; + if ($run_state eq 'new') { + $command .= " -addwarped"; + $command .= " -tess_id $tess_dir"; + $command .= " -path_base $outroot"; + $command .= " -hostname $host" if defined $host; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + } else { + $command .= " -updateskyfile"; + } + $command .= " -warp_id $warp_id"; + $command .= " -skycell_id $skycell_id"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + run(command => $command, verbose => $verbose); + } + exit $exit_code; +} + +END { + my $status = $?; + system("sync") == 0 + or die "failed to execute sync: $!" ; + $? = $status; +} + +__END__ Index: /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/whichimage =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/whichimage (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/scripts/whichimage (revision 41105) @@ -0,0 +1,229 @@ +#!/usr/bin/env perl + +# find out which "images" in a collection contain a given coordinate +# +# The collection can be a DVO database or an smf file. +# If none is supplied we search all tess_id in the site configuration +# uses dvoImagesAtCoords + +use warnings; +use strict; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use File::Temp qw( tempfile ); +use File::Basename; +use PS::IPP::Config qw( :standard ); +use IPC::Cmd 0.36 qw( can_run run ); + +my ( $ra, + $dec, + $tess_id, + $dvo_dir, + $smf, + $listchipcoords, + $one, + $verbose, + $save_temps, + ); + +GetOptions( + 'tess_id|t=s' => \$tess_id, + 'dvo_dir=s' => \$dvo_dir, + 'smf=s' => \$smf, + 'listchipcoords|c' => \$listchipcoords, + 'one' => \$one, + 'verbose' => \$verbose, + 'save-temps' => \$save_temps, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV > 2; +pod2usage( -msg => "Required options: ra decl", + -exitval => 3) if @ARGV < 2; + +my $missing_tools; +my $dvoImagesAtCoords = can_run('dvoImagesAtCoords') or (warn "Can't find dvoImagesAtCoords" and $missing_tools = 1); +if ($missing_tools) { + die("Can't find required tools."); +} + +my $ipprc = PS::IPP::Config->new(); + +# By convention our tess_ids are upper case +$tess_id = uc($tess_id); + +$ra = shift; +$dec = shift; + +# convert from sexagesimal to decimal degrees if coordinates contain ':' +if ($ra =~ /:/) { + my ($h, $m, $s) = split /:/, $ra; + + die "invalid ra: $ra\n" if !$h; + + my $sign = 1; + if ($h =~ /-/) { + $sign = -1; + $h = - $h; + } + + $h += ($m / 60) if $m; + $h += ($s / 3600) if $s; + + $ra = $h * 15 * $sign; +} +if ($dec =~ /:/) { + my ($d, $m, $s) = split /:/, $dec; + + die "invalid dec: $dec\n" if !$d; + + my $sign = 1; + if ($d =~ /-/) { + $sign = -1; + $d = - $d; + } + + $dec = $d; + $dec += ($m / 60) if $m; + $dec += ($s / 3600) if $s; + + $dec *= $sign; +} + +my ($ch, $coord_file) = tempfile ( "/tmp/coord.$$.XXXX", UNLINK => !$save_temps); +print $ch "1 $ra $dec\n"; +close $ch; + +my $cmd = "dvoImagesAtCoords -chipcoords $coord_file"; +$cmd .= " -listchipcoords" if $listchipcoords; + +$tess_id = uc($tess_id) if $tess_id; + +my $status = 0; +if ($dvo_dir) { + my $dvo_dir_resolved = $ipprc->convert_filename_absolute( $dvo_dir ); + die "failed to resolve $dvo_dir" if !$dvo_dir_resolved; + die "$dvo_dir not found" if ! -d $dvo_dir_resolved; + + my $label = basename($dvo_dir) if !$tess_id; + + if (!check_one($coord_file, " -D CATDIR $dvo_dir_resolved", $label)) { + $status = 0; + } +} elsif ($smf) { + my $smf_resolved = $ipprc->file_resolve($smf) or die "failed to resolve $smf"; + + $status = check_one($coord_file, " -astrom $smf_resolved", "chip"); +} else { + # assume that we will fail + $status = 1; + my @tess_ids_to_check; + if ($tess_id) { + @tess_ids_to_check = ($tess_id); + } else { + my $tessellations = metadataLookupMD($ipprc->{_siteConfig}, 'TESSELLATIONS'); + unless(defined $tessellations) { + die "Can't find TESSELLATIONS in site configuration"; + } + foreach my $tess (@$tessellations) { + my $tess_name = $tess->{name}; + # next if $tess_name eq 'FIXNS'; + # next if $tess_name eq 'ALLSKY'; + next if $tess_name eq 'RINGS.V0'; + push @tess_ids_to_check, $tess_name; + } + } + foreach $tess_id (@tess_ids_to_check) { + my $tess_dir = $ipprc->tessellation_catdir( $tess_id ); + # XXX: we are just skipping tessellations that are not resovlable + # perhaps we should raise an error + next if !$tess_dir; + my $tess_dir_resolved = $ipprc->convert_filename_absolute( $tess_dir ); + next if !$tess_dir_resolved; + next if ! -d $tess_dir_resolved; + + if (!check_one($coord_file, " -D CATDIR $tess_dir_resolved", $tess_id)) { + $status = 0; + last if $one; + } + } +} + +print STDERR "coordinates not found\n" if $status; + +exit $status; + +sub check_one { + my $infile = shift; + my $images_arg = shift; + my $component_label = shift; + + my $command = "$dvoImagesAtCoords -full-names -coords $infile $images_arg"; + $command .= " -listchipcoords" if $listchipcoords; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + if ($success) { + my @lines = split "\n", join("", @$stdout_buf); + foreach my $line (@lines) { + chomp $line; + my ($row, $ra, $dec, $component, $x, $y) = split " ", $line; + print "$ra $dec $component_label $component"; + if ($listchipcoords) { + print " $x $y"; + } + print "\n"; + } + } + return ! $success; +} + +__END__ + +=pod + +=head1 NAME + +whichimage - find images or skycells that contain a given ra and dec + +=head1 SYNOPSIS + + whichimage ra dec + [--tess_id | --dvo_dir | --smf | --one] + +=head1 DESCRIPTION + +whichimage finds which "images" in a given collection contain the given ra and dec. The collection is +determine by the arguments --tess_id --dvo_dir and --smf. If none of these is supplied all of the tesselations +in the site configuration are searched. + +=head1 OPTIONS + +=over 4 +=item * ra dec + +Coordinates to search for. + +=item * --tess_id + +Optional, Tessellation id to search for the coordinates. + +=item * --dvo_dir + +Optional, DVO database to search to search for the coordinates + +=item * --smf + +Optional, SMF file to search for the coordinates + +=item * --one + +Stop searching after finding one match. + +=back + +=head1 SEE ALSO + +L + +=cut Index: /branches/ccl_branches/ipponly-20191108/ippScripts/t/00_distribution.t =================================================================== --- /branches/ccl_branches/ipponly-20191108/ippScripts/t/00_distribution.t (revision 41105) +++ /branches/ccl_branches/ipponly-20191108/ippScripts/t/00_distribution.t (revision 41105) @@ -0,0 +1,25 @@ +#!/usr/bin/env perl + +# Copyright (C) 2005 Joshua Hoblitt +# +# $Id: 00_distribution.t,v 1.1 2007-01-30 01:52:16 jhoblitt Exp $ + +use strict; +use warnings FATAL => qw( all ); + +use lib qw( ./lib ./t ); + +use Test::More; + +# example taken from Test::Distribution Pod + +BEGIN { + eval { + require Test::Distribution; + }; + if($@) { + plan skip_all => 'Test::Distribution not installed'; + } else { + import Test::Distribution; # not => qw( podcover ); + } +}