#!/usr/local/bin/perl -w
##-------------------------------------------------------------------------
## 
## codastree -- 
## 
## Author          : Pierre Jaccard
## Created On      : 1999/09/06 13:16:30
## Last Modified By: Jaccard Pierre
## Last Modified On: 1999/09/20 12:53:34
## Update Count    : 125
## Directory       : /home1/jaccard/data/codas/codas3c/gfi/bin/perl/
## Version         : 0.0
## Status          : Unknown
## --------------------------------------------------------------------- ++
## DESCRIPTION: 
## 
##    See separate doc.
## 
## --------------------------------------------------------------------- ++
## REVISIONS: 
## --------------------------------------------------------------------- ++
## CHANGES:
## 
## 1999/09/20 Pierre Jaccard
##    Added a special method for parsing command line options, as older
##    version of Perl do not support the hash argument in function
##    getopts().   
##-------------------------------------------------------------------------

#------------------------------------------------------------------
# Modules:
#------------------------------------------------------------------

use strict;
use Carp;
use File::Copy;
use Getopt::Std;

select STDOUT; $|=1;
select STDERR; $|=1;

#------------------------------------------------------------------
# File Variables:
#------------------------------------------------------------------

my %CODAS = (
             'dbpath'   => "",
             'project'  => "",
             'dbtype'   => "",
             'codasdir' => "",
             'dbtypes'  => [],
             'alltypes' => [],
             'alldirs'  => [],
             'homedir'  => "$ENV{'HOME'}/.codas",
             'demodirs' => [
                            "_codasdir_/_dbtype_/demo",
                            "_codasdir_/gfi/demo/_dbtype_"
                           ],
             'typedirs' => [
                            "_codasdir_/gfi/demo",
                            "_homedir_/_project_/dbtree"
                            ],
             'homedemo' => [
                            "_homedir_/_project_/dbtree/_dbtype_"
                           ]
            );

#------------------------------------------------------------------
# Options
#------------------------------------------------------------------
{
  use vars qw(%OPTS);

  my($opt_str, $tmp_str, $c);

  $opt_str = 'p:t:uD:P:';

  ## 1999/09/20 Pierre Jaccard
  if($] < 5.004){
    my($tmp_str);
    
    $tmp_str = $opt_str;
    while($tmp_str){
      $c = chop($tmp_str);
      next if($c !~ /\w/);
      eval( 'use vars qw($opt_' . $c . '); $opt_' . $c . ' = 0;' );
    }
    getopts($opt_str) || die("\n\n");
    $tmp_str = $opt_str;
    while($tmp_str){
      $c = chop($tmp_str);
      next if($c !~ /\w/);
      eval( '$OPTS{' . $c . '} = $opt_' . $c . ' if($opt_' . $c .');' );
    }
  }
  else{
    getopts($opt_str, \%OPTS) || die("\n\n");
  }
    
}
       
#--- Default options:
$OPTS{'D'} = "$ENV{'CODASHOME'}" if(!$OPTS{'D'} && exists($ENV{'CODASHOME'}));
confess("\nMissing path to CODAS package\n\n") unless($OPTS{'D'});

#------------------------------------------------------------------
# Command line:
#------------------------------------------------------------------

$CODAS{'dbpath'} = $ARGV[0] if(@ARGV > 0); 

#------------------------------------------------------------------
# Update main hash:
#------------------------------------------------------------------

$CODAS{'project'} = $OPTS{'p'} if($OPTS{'p'});
$CODAS{'project'} = $OPTS{'P'} if($OPTS{'P'});
$CODAS{'codasdir'} = "$ENV{'CODASHOME'}" if(exists($CODAS{'CODASHOME'}));
$CODAS{'codasdir'} = $OPTS{'D'} if($OPTS{'D'});

#--- Controls:
confess("\nMissing database name and path\n\n") unless($CODAS{'dbpath'});
confess("\nMissing path to CODAS package\n\n")  unless($CODAS{'codasdir'});

#--- Get all possible database types:
{
  my(%types, $dir, @tmp, $tmp, @types, $type, $reg);

  %types = ();
  foreach $dir (@{$CODAS{'typedirs'}}){
    $dir = complete_name($dir);
    #--- Skip non-existing directories:
    next unless(-d $dir);
    #--- Get list of possible types:
    opendir(DIR, $dir) || confess("\nOpening directory $dir\n\n");
    @tmp = readdir(DIR);
    closedir(DIR) || confess("\nClosing directory $dir\n\n");
    #--- Select:
    foreach $tmp (@tmp){
      next unless(-d "$dir/$tmp");
      next if($tmp =~ /\.$/);
      $types{$tmp}++ ;
    }
  }
  @types = sort { $a cmp $b } (keys %types);
  $CODAS{'dbtypes'} = $CODAS{'alltypes'} = [ @types ];

  ##foreach(@types){ print "TYPES: $_\n"; };

  #--- Controls:
  $CODAS{'dbtypes'} = [ split(/,/, $OPTS{'t'}) ] if($OPTS{'t'});
  foreach $type (@{$CODAS{'dbtypes'}}){
    confess("\nDatabase type $type does not exist\n\n")
      unless(exists($types{$type}));
  }

  ## foreach(@{$CODAS{'dbtypes'}}){ print "DBTYPES: $_\n"; };
  
}

#------------------------------------------------------------------
# MAIN
#------------------------------------------------------------------

#--- Create the database root directory:
make_directory($CODAS{'dbpath'});

#--- Build list of directories to copy:
{
  my(@dirs, $type, $dir, @all);

  @all = ();
  unless($OPTS{'p'}){
    foreach $type (@{$CODAS{'dbtypes'}}){
      $CODAS{'dbtype'} = $type;
      @dirs = @{$CODAS{'demodirs'}};
      foreach $dir (@dirs){        
        $dir = complete_name($dir);
        next unless(-d $dir);
        push(@all, $dir);
      }
    }
  }
  if($OPTS{'p'} || $OPTS{'P'}){
    foreach $type (@{$CODAS{'dbtypes'}}){
      $CODAS{'dbtype'} = $type;
      @dirs = @{$CODAS{'homedemo'}};
      foreach $dir (@dirs){
        $dir = complete_name($dir);
        next unless(-d $dir);
        push(@all, $dir);
      }
    }
  }
  $CODAS{'alldirs'} = [ @all ];

  ## foreach(@{$CODAS{'alldirs'}}){ print "DIRS: $_\n"; };

}

#--- Install the files:
{
  my($dir, @dirs, $d, @tmp, $tmp, $dd);

  foreach $dir (@{$CODAS{'alldirs'}}){
    #--- Loop through directory tree:
    @dirs = ($dir);
    while($d = shift(@dirs)){
      #--- Get all content:
      opendir(DIR, $d) || confess("\nOpening directory $d\n\n");
      @tmp = readdir(DIR);
      closedir(DIR) || confess("\nClosing directory $d\n\n");
      #--- Select:
      foreach(@tmp){
        $_ = "$d/$_";
        next if(/\.$/);
        #--- Resolve symbolic links:
        $tmp = $_ ;
        while(-l $_){
          ($dd) = ($_ =~ /(.*)\//);
          $_ = readlink($_) || confess("\nReading symbolic link $_\n\n");
          $_ = "$dd/$_"; # Assuming relative links only !!!
        }
        push(@dirs, $_), next if(-d $_);
        #--- Copy files:
        copy_file($dir, $tmp);
      }
    }
  }
}

exit(0);

#------------------------------------------------------------------

sub make_directory {

  my($mode);

  my($dir) = @_ ;

  $mode = 2**8 + 2**7 + 2**6 + 2**5 + 2**3 + 2**2 + 2**0;

  if(! -d $dir){
    warn("Creating directory $dir\n");
    mkdir("$dir", $mode) || confess("\nCreating directory $dir\n\n");
  }

  return(1);
}

#------------------------------------------------------------------

sub complete_name {

  my($k, $reg);

  my($dir) = @_ ;

  #--- Complete name:
  foreach $k (keys %CODAS){ 
    $reg = quotemeta('_' . $k . '_');
    $dir =~ s/$reg/$CODAS{$k}/g;
  }

  return($dir);
}

#------------------------------------------------------------------

sub copy_file {

  my($type, $reg, $dst, $d, @dirs);

  my($dir, $file) = @_ ;

  #--- Get the database type and root directory:
  if($dir =~ /demo$/){
    ($type) = ($dir =~ /^.*\/(\w+)\/demo$/);
  }
  else{
    ($type) = ($dir =~ /^.*\/(\w+)$/);
  }
  $reg = quotemeta($dir);
  
  #--- Build destination:
  $dst = $file;
  $dst =~ s/^$reg//g;
  $dst = "$CODAS{'dbpath'}/$type$dst";
  
  #--- Get list of subdirectories:
  @dirs = split(/\//, $dst);
  pop(@dirs);
  $d = "";
  while((@dirs)){
    $d = "$d/" . shift(@dirs);
    $d =~ s/^\/// if(/^\//);
    make_directory($d);
  }

  #--- Resolve symbolic links:
  while(-l $file){
    ($d) = ($file =~ /(.*)\//);
    $file = readlink($file) || confess("\nReading symbolic link $file\n\n");
    $file = "$d/$file"; # Assuming relative links only !!!
  }
  
  if($OPTS{'u'} && file_uptodate($file, $dst)){
    print STDERR "$dst is up to date\n";
  }
  else{
    print STDERR "$file ->\n   $dst\n";
    copy($file, $dst) || confess("\nCopying $file to $dst\n\n");
  }

  return(1);
}

#------------------------------------------------------------------

sub file_uptodate {

  my(@stat, $t_ref, $t_file);

  my($ref, $file) = @_ ;

  if(! -s $file){ return(0); }
  -s $ref || confess("\nFile $ref does not exist\n");
  
  $t_ref  = $stat[9] if( (@stat = stat($ref)) );
  $t_file = $stat[9] if( (@stat = stat($file)) );
  confess("\nCannot stat time from files $ref and/or $file\n") 
    unless($t_ref && $t_file);
  
  return($t_file > $t_ref);

};
