#!/usr/bin/env perl
#----------------------------------------------------------------------------
#
# Name: set_catalog_lock.pl
#
# This perl script is used for the set_lock task in the OPUS pipeline for the 
# OSF that processes science POD files (data_id = pod). Interactive mode is used
# only during testing.
#
# Interactive Usage:
#	>set_catalog_lock.pl pod_rootname
#
#       where pod_rootname must have an entry in the OPUS podnames table.
#       and the default directory must be the catalog lock directory.
#
# Pipeline Usage:
#       command:set_catalog_lock.pl 
#     
#       In the pipeline the resource file must set the following ENV 
#       variable: OSF_DATASET
#
#	Note that the following environment variables (logicals) are 
#       always required in both modes: DSQUERY and OPUS_DB.
#
#
# History:
# Date     OPR      Who         Reason
# -------- -------- ----------  ---------------------------------------------
# 09/07/04 51692    Baum        Initial code
# 08/08/05 53402    Baum        Handle no records in podnames with warning.
# 03/25/10 64274    MSwam       Replace ST_DBlib with DBI
# 03/30/12 70831    Sherbert    For now add messaging and change DSQUERY to OPUS_SERVER
#----------------------------------------------------------------------------
# set up external routines
unshift @INC,(split /:/, $ENV{PATH});
require 'printmsg.pl';       # prints a formatted status message
require 'do_dbi_pkg.pl'; # run queries that return records

#specify exit status values

    $EXIT_FAILURE =     7;   # exit status for XPOLL
    $EXIT_SUCCESS =     9;   # exit status for XPOLL
    $EXIT_GO_ABSENT = 102;   # forces process to go absent

#check for arguments

    $num_arg = scalar @ARGV;
    # get pipeline ENV variable
    $osf_root = $ENV{"OSF_DATASET"};

    if ($num_arg > 0 && substr($ARGV[0],0,1) ne "-") {
        $interactive = 1;
    } elsif (defined($osf_root)) {
        $interactive = 0;
    } else {
        $fail_msg = 
            "Usage example: >set_catalog_lock.pl <pod_name>\nTry again.\n"; 
        print $fail_msg;
        exit( $EXIT_FAILURE);
    }
    if ($interactive) {
        # get osf_root from argument
        $osf_root = $ARGV[0];
        $lock_dir = "./";
        $OPUS_SERVER = $ENV{"OPUS_SERVER"};  # use interactive name
    } else {
        # get resource variable
        $lock_dir = $ENV{"CATALOG_LOCK_DIR"};
        $OPUS_SERVER = $ENV{"OPUS_SERVER"};  # use pipeline name
        
        if (!defined( $lock_dir)) {
            PrintMsg("F","Missing ENV variable CATALOG_LOCK_DIR.");
            exit( $EXIT_GO_ABSENT);
        }
    }
    $OPUS_DB= lc($ENV{"OPUS_DB"});

    if (!defined($OPUS_SERVER) || !defined($OPUS_DB) ) {
        PrintMsg("F","Missing ENV variable: OPUS_SERVER or CATALOG_LOCK_DIR.");
        exit ( $EXIT_GO_ABSENT);
    }        
    # begin processing
    PrintMsg ("I","--- start --- Set Catalog Locks for $osf_root");
    
    # open database for queries
    $db = DoDBIopen( $OPUS_SERVER, $OPUS_DB, $EXIT_FAILURE);
    
    # get all the ippsssoots for this POD file
    @ipppssoot_list = get_ipppssoot_list( uc($osf_root));
    
    if ((scalar @ipppssoot_list) == 0) {
        PrintMsg("W","Pod name $osf_root not found in podnames table.");
        PrintMsg("I","Assuming $osf_root contained only SHP - no locks set.");
        PrintMsg("I","---  end  --- Set Catalog Locks for $osf_root");
        DoDBIclose($db);
        exit ($EXIT_SUCCESS);
    }
    # get list of locks
    @lock_list = get_lock_list( \@ipppssoot_list);

    # end of all queries
    DoDBIclose($db);

    # create lock files by opening a file for write access
    foreach $lock (@lock_list) {
        $lock_file_name = $lock_dir.lc($lock).".".$osf_root;
        if (!(open (LOCKFILE, ">$lock_file_name"))) {
            PrintMsg("E","Cannot open $lock_file_name.");
            exit ($EXIT_FAILURE);
        } else {
            PrintMsg("I","Created lock file: $lock_file_name ");
            close LOCKFILE;
        }
    }    
    PrintMsg ("I","---  end  --- Set Catalog Locks for $osf_root");
    exit ($EXIT_SUCCESS);    

#---------------------------------------------------------------------
# end of main procedure -- subroutines follow
#---------------------------------------------------------------------
sub get_ipppssoot_list {
    # one argument - upcased POD name
    #
    # Query podnames to find all ipppssoot values for this POD file
    # returns a list of upper case ipppssoot values
    
    my ($podname)  = @_;
    my $query = <<"EOQ";
SELECT ipppssoot FROM podnames WHERE podname='$podname'
EOQ

    my $err_msg1 = "Cannot query first ipppssoot.";
    my $err_msg2 = "Cannot query next ipppssoot.";
    my @ippp_list = ();
    
    PrintMsg('D', $query ); 
    $sth = DoDBIexecute( $db, $query);
    while ( ( $ipppssoot) = DoDBIfetch( $db, $query, $sth) ) {
        push @ippp_list, $ipppssoot;
    }
    my $ippp_count = scalar @ippp_list;
    PrintMsg("I","Found $ippp_count records in podnames."); 
    PrintMsg('D',"The $ippp_count ipppssoots for $podname are: @ippp_list");
    @ippp_list;
}
#---------------------------------------------------------------------
sub get_lock_list {
    # one argument - reference to array of ipppssoots
    #
    # for each ipppssoot in list, either use the association name or the 
    # ipppssoot name, and check that names are not reused; 
    # return a list of unique lock names
    
    my ($list_ref)  = @_;
    my $lock_names = "";  # unique names separated by single blank
    
    foreach my $ipppssoot (@$list_ref) {
        PrintMsg('D', "asn_list=get_asn_list(ipppssoot=$ipppssoot)" ) ;
        my @asn_list = get_asn_list($ipppssoot);
        
        if ((scalar @asn_list) == 0) {
            PrintMsg('D', "asn_list = (ipppssoot ($ipppssot)) " );
            @asn_list = ($ipppssoot);  # use ipppssoot instead of asn name
        }
        # add unique values to $lock_names 
        foreach $asn_name (@asn_list) {
            if ($lock_names eq "") {
                $lock_names = $asn_name;
                PrintMsg('D', "lock_names ($lock_names) = asn_name ($asn_name)");
            } else {
                # use index function to check for duplicate entry
                if (index( $lock_names, $asn_name) == -1) {
                    PrintMsg('D', "(index(lock_names, asn_name) == -1) ");
                    PrintMsg('D', "lock_names ($lock_names) .= asn_name ($asn_name)");
                    $lock_names .= " $asn_name";
                }
            }
        }
    } 
    # return list of lock names    
    PrintMsg('D', "returning lock name list: $lock_names " );
    split / /, $lock_names;
}
#---------------------------------------------------------------------
sub get_asn_list {
    # one argument - ipppssoot
    #
    # get list of associations for which this ipppssoot is a member
    
    my ($ipppssoot) = @_;;
    my $program_id = substr($ipppssoot,1,3);
    my $obset_id = substr($ipppssoot, 4, 2);
    my $member_num = substr($ipppssoot, 6, 2);
    my $query = <<"EOQ";
SELECT association_id FROM asn_members 
WHERE program_id = '$program_id' and
      obset_id = '$obset_id' and
      member_num = '$member_num'
EOQ
    my @asn_list = ();    

    PrintMsg('D', $query ); 
    $sth = DoDBIexecute( $db, $query);
    while ( ($asn_id) = DoDBIfetch( $db, $query, $sth) ) {
        push @asn_list, $asn_id;
    }
    PrintMsg('D', "returning asn_list: @asn_list " );
    @asn_list;
}