#!/usr/bin/env perl
#!/usr/local/bin/perl
##########################################################################
#
# FILE:
#       upp
# 
# DESCRIPTION: 
#       UPP main routine
#       (for more info, see pod at the end).
#
# AUTHORS:
#       Marc Mengel
#       Lars Rasmussen
#       Margaret Votava
#       Don Walsh
#
#       Fermilab Computing Division #       Batavia, IL 60510, U.S.A.                                              # # MODIFICATIONS:
#
##########################################################################

BEGIN {
    die "UPD_DIR is not defined ... we are quitting.\n" unless ( $ENV{UPD_DIR} );
    unshift @INC, "$ENV{UPD_DIR}/src";
}

package upp;

use upputil;
use uppmail;
use upduti;
use updups;
use updupr;
use updgbl;
use upderr;

use FileHandle;
use Time::gmtime;
use strict;
use Exporter();
use vars qw( @ISA @EXPORT $resolvebuf $have_resolve_data);

@ISA = qw( Exporter );

##########################################################################
# Exported functions
#

@EXPORT = qw (
    upp_fileHeader
    upp_prodRecord
    upp_getProdInstance
    upp_sendMail
    upp_find_product
    print_hash
    upp_doActions
    );

##########################################################################
# Global and local variables
#
my %mailInfo = ();          # used by mail
my $status = 0;

my $uppDataFilename = "uppdata.txt";    #Default upp datafile filename

##########################################################################
# Begin upp code
#

if ( $ARGV[0] =~ m/-v+/ ) {
   my $arg = shift;
   my @vlist = ($arg =~ m/v/g);

   upderr_setverbose( int(@vlist));

} else {
   upderr_setverbose (0);

}

upderr_log(1,"upp: starting with " . join(' ', @ARGV) . "\n");
     
if ($#ARGV > -1) {
    foreach (@ARGV) {
	upp($_)
    }
} else {
	print STDERR "Usage: upp filename\n";
}
exit 0;

#
# collapse a sorted list to just unique items, a'la unix "uniq"
#
sub uniq {
    my @out = ();
    my $last = "";

    for (@_) {
 	if ($_ ne $last) {
	    push @out, $_;
	}
	$last = $_;
    }
    return @out;
}

#
# handle one subscription file
#
sub upp {
    my ($subFilename) = @_;
    my $tolc;			# time of last contact for this server.

    my %file_header = (
	file => 		'',
	mail_address =>		'',
	dist_node => 		'',
	dist_db   => 		'',
	newprod_notify  => 	'',
	data_dir  => 		'',
	);

    my $subFileHandle = new FileHandle;
    my $dataFileHandle = new FileHandle;
    my $dataFileName;
    my $res = 1;
        
    unless (open $subFileHandle, $subFilename) {
        upderr_log( 0, "ERROR: Can't open file: $subFilename\n");
        return 0;
    }
    
                                # read the subscription file header 
    $status = upp_fileHeader ( $subFileHandle, \%file_header );
    if ( ! $status ) {
        upderr_log( 0, "ERROR: upp_fileHeader failed.\n");
	upderr_get(); upderr_clear();
        close $subFileHandle;
        return 0;
    }

    if ( $file_header{'newprod_notify'} eq 'T' ) {

	upderr_log(1, "Doing new product notification\n");
	upderr_get(), upderr_clear();

	my (@oldprods, @newprods, @outprods, @errs);

	(@oldprods, @newprods, @outprods) = ();
        uppmail_log("Product change list:\n");

	$dataFileName = "$file_header{data_dir}/upp.prodlist";
        if (open($dataFileHandle,"<$dataFileName")) {
	    while (<$dataFileHandle>) {
                chomp();
 	        push @oldprods , $_;
	    }
	    close($dataFileHandle);
	}
	updupr_oxc( $file_header{dist_node} , 'list -a -K product', \@newprods, \@errs);

	upderr_log(2, "After fetch, old list has $#oldprods items, new has $#newprods\n");
	upderr_get(), upderr_clear();

	@oldprods = uniq(sort @oldprods);
	@newprods = uniq(sort @newprods);

        while ( $#oldprods > -1 && $#newprods > -1) {
	    if ( $newprods[0] lt $oldprods[0] ) {

	       uppmail_log("Product $newprods[0] has been added\n");

	       push @outprods, $newprods[0];
	       shift @newprods;

	    } elsif ( $oldprods[0] lt $newprods[0] ) {

	       uppmail_log("Product $oldprods[0] has been dropped\n");
	       shift @oldprods;
	    } else {
	       upderr_log(4,"product $newprods[0] remains...\n");
	       shift @newprods;
	       shift @oldprods;
	    }
	}
        while ( $#newprods > -1) {
	       push @outprods, $newprods[0];
	       shift @newprods;
	}
        upderr_get(); upderr_clear();

        uppmail_log(" - - - - - - - - - - - - - - -\n");
        if (open($dataFileHandle, ">$dataFileName")) {
	    upderr_log(2,"writing $#outprods items to $dataFileName");
	    foreach (@outprods) {
		print $dataFileHandle $_ , "\n";
	    }
	    close($dataFileHandle);
	} else {
	    upderr_log(0, "unable to update $dataFileName");
	    uppmail_log("unable to update $dataFileName");
	}
    }

    $dataFileName = "$file_header{data_dir}/upp.tolc";

    if (open($dataFileHandle,"<$dataFileName")) {
	$tolc = <$dataFileHandle>;
	close($dataFileHandle);
    } else {
	$tolc = "";   # a really long time ago, before there were dates :-)
    }


    # read products and actions from subscription file

    $status = upp_prodRecord($subFileHandle, \%file_header, $tolc);
    if ( ! $status ) {
        upderr_log( 0, "ERROR: upp_prodRecord failed.\n");
    }
    close $subFileHandle;
    upderr_get (); upderr_clear();
    

    $mailInfo{ 'to' }      = "$file_header{'mail_address'}\n";
    $mailInfo{ 'from' }    = "upp\n";
    $mailInfo{ 'subject' } = "$file_header{'file'}\n";
    $mailInfo{ 'message' } = "Results of upp $file_header{'file'}\n";
    $mailInfo{ 'message' } .= uppmail_get;
    unless ( uppmail_send ( \%mailInfo )) {
	upderr_log(0, "Can't send Mail to $file_header{'mail'}\n");
	$res = 0;
    }

    if ($res) {
       my $gm = gmtime();
       open($dataFileHandle , ">$dataFileName");
       printf($dataFileHandle "%04d-%02d-%02d %02d.%02d.%02d GMT\n",
	    $gm->year() + 1900, $gm->mon() + 1, $gm->mday(), 
		$gm->hour(), $gm->min(), $gm->sec);
       close($dataFileHandle);
    }

    upderr_get (); upderr_clear();
    return $res;
}
                
#-------------------------------------------------------------------------
# $status = upp_fileHeader( $fh, \%file_header)
#
# Reads the subscription file filling in the file_header.
#
# Input : 
#         filehandle, $fh
#         hash, $fileHeader
# Output: none
# Return: 1 if successful else 0 if any errors
#

sub upp_fileHeader {
    my ( $fh, $fileHeader) = @_;

    my $s1 = '';
    my $s2 = '';

    upderr_log(1,"Entering upp_fileHeader\n");
    while(<$fh>) {
        
        upderr_log(3,"read: $_");
        if ((/^#/ ) or ( ! /\w/ )) { # skip comments and blank lines
            next;
        }
        
        chop $_;
        ($s1, $s2) = split /\s*=\s*/, $_, 2;

        if ($s1 =~ m/BEGIN/i) {       # get rest of the product info
            return 1;
        }
                
        if ($s1 =~ m/(FILE|MAIL_ADDRESS|DIST_(NODE|DB)|NEWPROD_NOTIFY|DATA_DIR)/i){
 	    my $tag = $s1;
	    $tag =~ tr[A-Z][a-z];
            $fileHeader->{$tag} = $s2; 
	}
            
        if (eof) {
            return 0;
        }
    }
}
                
#-------------------------------------------------------------------------
# $status = upp_prodRecord( $fh, \%fileHeader, $tolc)
#
# Reads the subscription file filling in the product record.
# When 'END' is found it makes calls to UPS to check the product
# status. Compare the declared instance with the declared instance
# in the local upp datafile. Perform the actions specified for
# each product in the local upp datafile.
#
# Input : 
#         $filehandle, $fh
#         hash,   $fileHeader
#         scalar, $dataFilename
# Output: none
# Return: 1 if successful else 0 if any errors
#

sub upp_prodRecord {
  my ( $fh, $fileHeader,  $tolc ) = @_;

  my $s1 = '';
  my $s2 = '';
  my $status;
  my $inst_spec_list = [];	# Filled in from ups_database
  my $inst_spec = {};     	# item from above list
  my $data_spec = {};     	# filled in from local upp datafile
  my $actions = {};	    	# actions for various chains/versions
  my $aryptr = [];	    	# pointer to list of actions
  my $chainpat;	    	# pattern to match chain/version for action
  my $date;			# date of chain/version
  my $dep_list;		# dependency list for each product
  my $dep_inst;		# dependency instance
  my $needsupdate;		# flag if product needs updating
  my @updatelist;		# dependency list needing updates
  my %actlist;		# actions for this pass
  
  upderr_log(1,"Entering upp_prodRecord\n");

  while(<$fh>) {

    upderr_log(3,"read: $_");

    if ((/^#/ ) or ( ! /\w/ )) {    # skip comments and blank lines
	next;
    }

    chop $_;
    ($s1, $s2) = split /\s*=\s*/, $_, 2;
    
    if ($s1 =~ m/END/i ) {

      upp_getProdInstances ('list', $fileHeader, $data_spec, 
			    $inst_spec_list );

      foreach $inst_spec (@{$inst_spec_list}) {
        #
        # so far no reason to update this product
	#
	$needsupdate = 0;

	#
	# so far no actions to perform if we do
        #
	%actlist = ();

	#
	#   First check if the version/chain matches from any actions
	#

	foreach $chainpat (keys %$actions) {

	  upderr_log(4,"checking against $chainpat\n");

	  if ($inst_spec->{chain} =~ m/$chainpat/ ||
		       $inst_spec->{version} =~ m/$chainpat/ ) {

	     #
	     # if so, we think we need to update it
 	     # (although we may soon change our mind)
	     #
	     $needsupdate = 1;

	     #
	     # the actions for this Action= need to be done if so...
	     #
	     my $act;
             foreach $act (@{$actions->{$chainpat}}) {
 		$actlist{$act} = 1;
	     }
	  }
	}

	#
	# next see if any of its dependencies have changed
	#
	if ( $needsupdate ) {

	  @{$dep_list} = ();
	  upp_getProdInstances('depend', $fileHeader, $inst_spec, $dep_list );

	  #
	  # we now again don't beleive it needs updating, unless we see
	  # triggering timestamp in a dependency.
	  #
	  $needsupdate = 0;

	  #
	  # so far, no dependencies need updating
	  #
	  @updatelist = ();

	  foreach $dep_inst (@{$dep_list}) {

	    upderr_log(3,"checking dep spec:\n");
	    upduti_print_instance_spec(3,$dep_inst);

	    #
	    # Check both declare/modify dates on both
	    #   version and chain for updates... 
	    #
	    dateloop:
	    foreach $date ( split(":", $dep_inst->{declared}), 
			  split(":", $dep_inst->{modified})) {

	      if ($date gt $tolc ) {

		upderr_log(3,"date $date newer than tolc $tolc\n");

		# 
		# now we once again believe we need to update, since a
		# newer product date was found, and this is one of the
	        # ones we need to update.
		# 
		$needsupdate = 1;
	        push @updatelist, $dep_inst;
		last dateloop;

	      } else {
		upderr_log(3,"date $date older than tolc $tolc\n");
	      }
	    }
	  }
	}

	#
	# Finally, if we still think we need it, do the update action.
	#
	if ($needsupdate) {
	  upderr_get(); upderr_clear();
	  upp_doActions( $inst_spec, [keys(%actlist)] , \@updatelist );
	  upderr_get(); upderr_clear();
	}
      }
    } elsif ($s1 =~ m/BEGIN/i ) {
      $actions = {};
      next; }
	
    elsif ($s1 =~ m/PRODUCT|FLAVOR|VERSION|QUALIFIERS|PROD_DIR|CHAIN/i){
	my $tag = $s1;
	$tag =~ tr[A-Z][a-z];
	$data_spec->{$tag} = $s2; }
	
    elsif ( $s1 =~ m/ACTION/i and $s2 eq "newversion" ) {
	$aryptr = [];
	$actions->{'.*'} = $aryptr; }
	
    elsif ( $s1 =~  m/ACTION/i  ) {
	$aryptr = [];
	$chainpat = $s2;
	$chainpat =~ s/\W/\\$&/go;	
	$actions->{$s2} = $aryptr; }
	
    else {
	    $s1 =~ s/\s//g;
	    push (@{$aryptr}, $s1);
    }
		  
  }
  return 1;
}

#-------------------------------------------------------------------------
# $status = upp_getProdInstances( $fileHeader, $inst_spec, $inst_spec_list)
#
# Get the product instance from the ups_database
#
# Input : 
#         scalar, 	$filehandle
#         hash,   	$inst_spec
#
# Output: 
#	  array o'hash, $inst_spec_list
#
# Return: 1 if successful else 0

sub upp_getProdInstances {
    my ( $cmd, $fileHeader, $inst_spec , $inst_spec_list ) = @_;

    my $rhost = '';
    my $buf = '';

    upderr_log( 3 , "upp_getProdInstance input: ($cmd,$fileHeader,$inst_spec)\n");

    if ( defined $fileHeader->{'dist_node'} ) {
        $rhost = $fileHeader->{'dist_node'};
    } else { 
	$buf = "Distribution Node is NOT defined.\n";
	upderr_log( 0 , $buf);
	uppmail_log( $buf );
	return 0;
    }

    if ( updups_list_depend_K ( $rhost, $cmd, [$inst_spec], $inst_spec_list, 
		'product', 
		'version', 
		'flavor', 
		'qualifiers', 
		'chain', 
		'declared', 
		'modified' ) ) {
        return 1;
    } else {
	$buf = "NOT found: " . ispec2str( $inst_spec ) . "\n";
	upderr_log ( 0 , $buf );
	uppmail_log( $buf );
	return 0;
    }
}
    
#-------------------------------------------------------------------------
# $status = upp_doActions( \%inst_spec, \@actions, \@updatelist );
#
# Perform the actions specified in the list for the product.
#
# Input : 
#         hash,  \%inst_spec
#         array, \@actions
# Output: none
# Return: 1 if successfule else 0
#

my $resolvebuf, $have_resolve_data;

sub upp_doActions {
    my ( $inst_spec, $actions, $updatelist ) = @_;
    my ($u_spec, $action, $opts);

    upderr_log(1,"Entering...\n");
    upderr_log(2,"actions: @{$actions}\n");
    upderr_log(2,"updatelist: @{$updatelist}\n");

    $opts = ispec2str( $inst_spec );

    foreach $action (@{$actions}) {

        upderr_log(3,"action $action...\n");

        if ($action =~ m/notify/i) {
             upderr_log(4,"mail stuff...\n");
	     uppmail_log( "Update needed for: " . ispec2str( $inst_spec ));
	     uppmail_log( "due to timestamps on:\n");
	     foreach $u_spec (@{$updatelist}) {
		uppmail_log( "\t" . $u_spec->{product} . ' ' . $u_spec->{versoin} . "\n");
	     }
	     uppmail_log( "- - - - - - - - - - \n");
        }
        if ($action =~ m/reget/i) {
            upderr_log(4,"reget undeclare stuff...\n");
	    foreach $u_spec (@{$updatelist}) {

		upderr_log(4,"undecl $u_spec->{product} $u_spec->{version}\n");

		delete $u_spec->{chain};
		updups_undeclare(0,$u_spec,$u_spec,"-d");
	    }
        }
        if ($action =~ m/reget|install/i) {
            upderr_log(4,"install stuff...\n");

            if ( upderr_getverbose > 0 ) {
		$resolvebuf = `upd install -v $opts`;
	    } else {
		$resolvebuf = `upd install $opts`;
 	    }
	    if ($resolvebuf =~ s/.*Execute the following to resolve chains://s){
		upderr_log(2,"Resolve actions collected:\n $resolvebuf\n");
		$have_resolve_data = 1;
	    } else {
		upderr_log(0, "failed: upd install $opts ");
	    }
	}
        if ($action =~ m/update/i) {
            my $res;
	    $res = system( "upd update table_file:ups_dir $opts" );
            if ($res != 0) {
		upderr_log(0, "failed: upd update $opts ");
            }
	}
        if ($action =~ m/resolve/i) {
            upderr_log(4,"resolve stuff...\n");

	    upderr_log(2,"Resolve actions about to exeucte:\n $resolvebuf\n");
	    system( $resolvebuf );
	    $have_resolve_data = 0;
	}
    }
    return 1;
}
