#!/usr/bin/perl -w

###########################################################
#
# @file: config/saga-install.pl(.in)
#
# @description:
#   used to install SAGA components into the target location.
#   The target location is either specified at configure time, 
#   via --prefix, or at runtime, via the SAGA_PREFIX 
#   environment variable, which overrides the configure prefix.
#   SAGA_PREFIX defaults to SAGA_LOCATION, if that is set instead.
#
#   The script logs all activities to 
#   $SAGA_PREFIX/share/saga/install.log, 
#   which allows for later 'make uninstall'
#
# Copyright (c) 2010 Andre Merzky (andre@merzky.net)
# This file is part of the SAGA Engine.
#
###########################################################

### LICENSE ###

BEGIN {
  use strict;

  # don't use any additional modules like getopt to increase portability

  # FIXME - needed?
  use Fcntl ':flock'; # import LOCK_* constants

  sub usage    ( ;$);
  sub my_mkdir ($;$);
}


my $debug = 0;


sub usage (;$)
{
  my $msg = shift || undef;

  if ( defined ($msg) )
  {
    print <<EOT1;

  Error:    $msg

EOT1
  }

  print <<EOT2;

  Usage:    $0 [opts] <component> <path/to/dir/>

  Options:  -r        component is only registered, not really installed
            -vx.y     component obtains a version postfix, and a symlink
                      original component name 
            -n        do nothing, only print commands to be run
            -a alias  after install, link the src to the name 'alias' in 
                      the same directory


  Examples: saga-install.sh saga_main.hpp include/saga/saga.hpp 
                                 --> include/saga
              saga_main.hpp      --> include/saga/saga.hpp

            saga-install.sh doc/ share/saga/doc/
                                 --> share/saga/doc/
              docs/README        --> share/saga/doc/README
              docs/INSTALL       --> share/saga/doc/INSTALL
              docs/...           --> share/saga/doc/...

            saga-install.sh -r install.log share/saga/install.log
              # the file is       not copied, only registered 
              install.log        --> 

            saga-install.sh -v1.2 libsaga_job.so lib/libsaga_job.so
                                 --> lib
              libsaga_job.so     --> lib/libsaga_job.1.2.so

              # additionally, there will be symlinks like
              #   ln -s lib libsaga_job.1.2.so lib/libsaga_job.1.so
              #   ln -s lib libsaga_job.1.so   lib/libsaga_job.so

            saga-install.sh -a saga-job-run saga_job bin/saga-job
                                 --> bin
              saga-job           --> bin/saga-job

              # additionally, there will be a symlink
              #   ln -s saga-job saga-job-run
              # in the targed dir


  The target directory will _always_ be prefixed by
  SAGA_PREFIX, i.e. by the installation prefix.  <component>
  can be a file or directory.

  All installed components are registered in
  \$SAGA_LOCATION/share/saga/install.log, which is used by
  saga-uninstall.sh to find everything to be deleted.  The
  '-r' flag will let the script only register the component,
  but will not actually perform the copy. 

  The versioning flag -v is only supported for libraries,
  i.e. for .a, .so and .dylib extensions.


  KNOWN PROBLEMS: 
    - installing older versions with '-v' will remove 
      newer versions of the lib

EOT2
  exit 1;
}

open (LOG, ">/dev/null");

# main
{
  my $SAGA_LOC = "@SAGA_LOCATION@";

  if    ( $ENV{'SAGA_PREFIX'  } ) { $SAGA_LOC = $ENV{'SAGA_PREFIX'  }; }
  elsif ( $ENV{'SAGA_LOCATION'} ) { $SAGA_LOC = $ENV{'SAGA_LOCATION'}; }

  # we honor GNU conventions, and silently prepend the DESTDIR variable to the
  # installation prefix, if it exists
  if    ( $ENV{'DESTDIR'      } ) { $SAGA_LOC = "$ENV{DESTDIR}/$SAGA_LOC"; }

# get rid of trailing slashes
  $SAGA_LOC =~ s/\/+$//;

# check flags and args
  my $m_reg  = 0;
  my $ver    = 0;
  my $alias  = 0;
  my $i      = 0; # arg index

  foreach my $arg ( @ARGV )
  {
    if    ( $ARGV[$i] eq "-n" ) { $debug  = 1;                }
    elsif ( $ARGV[$i] eq "-r" ) { $m_reg  = 1;                }
    elsif ( $ARGV[$i] eq "-a" ) { $alias  = $ARGV[++$i] || 0; }
    elsif ( $ARGV[$i] eq "-v" ) { $ver    = $ARGV[++$i] || 0; }
    else                        { last;                       }

    $i++;
  }

  my $src = $ARGV[$i++] || usage ("no source specified!");
  my $tgt = $ARGV[$i++] || usage ("no target specified!");
  $tgt = "$SAGA_LOC/$tgt";

  # complain if tgt has trailing slashes for non-directories
  if ( $tgt =~ /\/$/ && ! -d $src )
  {
    die "Target should be the full file name, not a directory.\n";
  }

  # strip trailing slashes and double slashes
  $tgt =~ s/\/+$//g;
  $tgt =~ s/\/\//\//g;

  if ( $debug )
  {
    print <<EOT3;
    src  : $src
    tgt  : $tgt
    reg  : $m_reg
    ver  : $ver
    alias: $alias
EOT3
  }


# all activities are logged, for a later 'make uninstall'
  my $logd = "$SAGA_LOC/share/saga/";
  my $log  = "$logd/install.log";

  if ( ! -d $logd )
  {
    my_mkdir ($logd, 0);
  }

  unless ( $debug )
  {
    open  (LOG, ">>$log") or die "Cannot open log file $log: $!\n";
    flock (LOG, LOCK_EX);
  }


# for the version mode, make sure the component is a lib.  Also, replace the
# target name with the full expanded versioned name, and add the link targets.
# TODO

  my $tgt_dir;
  my $tgt_name;

  if ( $tgt =~ /^(.+?)\/([^\/]+)$/io )
  {
    $tgt_dir  = $1;
    $tgt_name = $2;
  }


  if ( ! $m_reg && ! $alias )
  {
    # if needed, we create the tgt' parent dir
    if ( ! -e $tgt_dir )
    {
      my_mkdir ($tgt_dir);
    }
    else
    {
      if ( ! -d $tgt_dir )
      {
        die "Target's parent dir ($tgt - $tgt_dir) exists and is not a directory\n";
      }
    }


    # copy src to target
    if ( $debug )
    {
      print "cp -rf $src $tgt\n";
    }
    else
    {
      if ( -e $tgt )
      {
        unlink ($tgt);
      }

      system ("cp -rf $src $tgt") == 0 || die "Cannot copy '$src' to '$tgt': $!\n";
    }



    # only register if we are not going to link later
    # FIXME: for dirs, we should actually register all contained elements
    # individually, so that uninstall does not delete later added elements.
    unless ( $ver || $alias )
    {
      if ( $debug ) {
        if   ( -d $tgt ) { print "LOG:  d $tgt\n"; }
        else             { print "LOG:  f $tgt\n"; } }
      else {
        if   ( -d $tgt ) { print  LOG  "d $tgt\n"; }
        else             { print  LOG  "f $tgt\n"; } }
    }
  }



  # now, for versioned libraries we need to do something more special.
  # First, move the installed file to a fully versioned one, link that to the
  # next major version, until we have a link chain to the original target

  if ( $ver )
  {
    my $lib_base;
    my $lib_ext;

    if ( $tgt_name =~ /^(.+)\.(so|dylib|a|dll)$/io )
    {
      $lib_base = $1;
      $lib_ext  = $2;

      # we only support versioing for files
      if ( -d $tgt )
      {
        die "versioning of directories is not supported\n";
      }

      # get list of valid version strings
      my @ver;  
      my $sub_ver = $ver;

      while ( 1 )
      {
        push (@ver, $sub_ver);

        if ( $sub_ver =~ /^([\d\.]+)\.(\d+)$/io )
        {
          $sub_ver =  $1;
        }
        elsif ( $sub_ver =~ /^(\d+)$/io )
        {
          last;
        }
        else
        {
          usage ("Can't parse version argument '$ver'");
        }
      }

      # do we have a useful version
      if ( scalar (@ver) > 0 )
      {
        # move the real target to the first (longest) version string
        my $this_ver  = shift (@ver);
        my $new_tgt   = "$tgt_dir/$lib_base.$this_ver.$lib_ext";
        my $new_tgt_s =          "$lib_base.$this_ver.$lib_ext";


        # move and register the new target
        if ( $debug )
        {
          print "mv -f $tgt $new_tgt\n";
          print "LOG: f $new_tgt\n";
        }
        else
        {
          system ("mv -f $tgt $new_tgt") == 0 || die "Cannot move '$tgt' to '$new_tgt'\n";
          print LOG "f $new_tgt\n";
        }


        # create the link chain
        while ( scalar (@ver) > 0 ) 
        {
          my $next_ver   = shift (@ver);
          my $link_tgt   = "$tgt_dir/$lib_base.$next_ver.$lib_ext";
          my $link_tgt_s =          "$lib_base.$next_ver.$lib_ext";

          # link targets need to be removed when preexisting
          if ( -e $link_tgt )
          {
            if ( $debug )
            {
              print "unlink $link_tgt\n";
            }
            else
            {
              unlink ($link_tgt);
            }
          }

          # link & register the new target
          if ( $debug )
          {
            print   "cd $tgt_dir && ln -s $new_tgt_s $link_tgt_s\n";
          }
          else
          {
            system ("cd $tgt_dir && ln -s $new_tgt_s $link_tgt_s");
            print LOG "l $link_tgt\n";
          }

          $new_tgt = $link_tgt;
        }


        # link & register the last new target
        if ( $debug )
        {
          print   "cd $tgt_dir && ln -s $new_tgt_s $tgt\n";
        }
        else
        {
          system ("cd $tgt_dir && ln -s $new_tgt_s $tgt");
          print LOG "l $tgt\n";
        }
      }
    }
    else
    {
      usage ("-v can only be used with libraries");
    }
  }
  

  if ( $alias )
  {
    my $link_tgt = "$tgt_dir/$alias";

    if ( ! -e $tgt )
    {
      die "Cannot create alias $alias for $tgt: target is not installed\n";
    }

    # link targets need to be removed when preexisting
    if ( -l $link_tgt )
    {
      if ( $debug )
      {
        print "unlink $link_tgt\n";
      }
      else
      {
        unlink ($link_tgt);
      }
    }

    # link & register the last new target
    if ( $debug )
    {
      print "symlink $tgt, $link_tgt\n";
    }
    else
    {
      symlink ($tgt_name, $link_tgt) || die "Cannot link '$tgt' to '$link_tgt'\n";
      print LOG "l $tgt\n";
    }
  }



  # beautify (== sort) log file 
  if ( $debug )
  {
    print "cat $log  | sort -k 2 | uniq > $log.$$\n";
    print "mv  $log.$$ $log\n";
  }
  else
  {
    system ("cat $log  | sort -k 2 | uniq > $log.$$") == 0 || die "Cannot sort log file: $!\n";
    system ("mv  $log.$$ $log")                       == 0 || die "Cannot sort log file\n";
  }
}

############################################################
#
# "mkdir -p", also registers created directories
#
sub my_mkdir ($;$)
{
  my $tmp  = shift;
  my $log  = shift || 1;
  my @tree = ();

  $tmp =~ s/\/$//og;

  push (@tree, $tmp);

  while ( $tmp =~ /^(.+)\/([^\/]+)$/io )
  {
    $tmp  = $1;
    push (@tree, $tmp);
  }

  foreach my $branch ( reverse @tree )
  {
    if ( ! -d $branch )
    {
      if ( $debug )
      {
        print "mkdir  $branch\n";
        print "LOG: D $branch\n" if $log;
      }
      else
      {
        mkdir ($branch) || die "Cannot create dir $branch: $!\n";
        print LOG "D $branch\n" if $log;
      }
    }
  }
}

END 
{
  # unlock even on bad exits
  unless ( $debug )
  {
    flock (LOG, LOCK_UN);
  }
}