#! /usr/bin/env tclsh
# -*- tcl -*-
# <20180610.1144.13>
#
# This is the filerunner install file.  The following locations are used
# to install filerunner.  For most installations, the default should be
# just what you need.

# This install file has a slightly different personality when not run by
# 'root', see the help message (INSTALL -help).
#
#  A pseudo root dir                {DESTDIR} / 
#  The code (all the run time bits) {CODE} /usr/share/filerunner/
#  The documentation (Help menu)    {DOCS} /usr/share/doc/filerunner/
#  Icons                            {ICON} /usr/share/icons/hicolor/
#  A link to the executable (fr)    {EXEC} /usr/bin/
#  Global config file               {GCONFIG} /usr/share/config/
#  Desktop file                     {DESKTOP} /usr/share/applications
#
# Note that DESTDIR is used mostly for building RPMs where we do an install
# that is then moved to a different location.
# These are the defaults and can be overridden by parameter in the run command
# or by env variables of the same name (run string overrides env)

#set add(prefix) "/usr/share"
#set add(CODE) "filerunner"
#set add(DOCS) "doc/filerunner"
#set add(FRLIB) "frlib/filerunner"  !!!! may not be overridden !!!!
#set add(GCONFIG) "config"
#set add(ICON) "icons/hicolor"
#set add(DESKTOP) "applications"
#set add(EXEC) "/usr/bin"

# The following three lists are 'paired', i.e. the second defines the
# locations used for the first.
set legal [list  DESTDIR prefix CODE DOCS GCONFIG ICON DESKTOP EXEC]
set legalhelp { 
  {A dir to use instead of '/' to allow a move later (cp DESTDIR/ to)}
  {Used as the prefix for all the following except EXEC} 
  {where to put the code} 
  {where to put the documentation files}
  {where the global or system configuration file is}
  {where to put the icons}
  {where to put the desktop file}
  {where to put a link to the run file}}

set rootloc {
  {}
  {/usr/share}
  {filerunner}
  {doc/filerunner}
  {config}
  {icons/hicolor}
  {applications}
  {/usr/bin}}

# the following sets the changes to the above for a non-root run.
set user_prefix [file normalize ~/.local/share]
set user_EXEC [file normalize ~/bin]

# the prefixed list contains the addresses that are 'prefix'ed
set prefixed [list CODE DOCS ICON GCONFIG DESKTOP]

# Legal flags (e.g. -verbose)
set legalmin [list verbose test testdir ask h help nogui gui]

set legalmhelp { 
  {Tell about everything INSTALL does.} 
  {Show what we would do (implies verbose)} 
  {Sets up a test directory and installs to it (sets DESTDIR to .TEST).} 
  {Ask for OK to continue in non-GUI mode.} 
  {Request this display.} 
  {Request this display.} 
  {Do not use GUI mode. (default if root)} 
  {Use GUI mode (default if not root and Tk is present)}}

# Check on who we are.  If not root we do different things...

set username [exec whoami]
set root [expr { $username == {root} ? 1 : 0}]
 
#
# Since we are 'intimate' with filerunner, lets use some of its resources...
#
if {[catch {info script} out] == 0} {
  set dir [file normalize [file dirname $out]]
} else {
  set dir [pwd]
}
# assume we are located one dir down (usually Makefiles)
set dir [file normalize $dir/..]
set HomeDir $dir
if {[file tail $dir] != "filerunner"} {
  set sterror1 "Possible error.  Expected to find filerunner here: $dir but found [file tail $dir]"
  puts "$sterror1"
}
#puts "$dir [info script]"
source [file join [info library] init.tcl]
lappend auto_path $dir
setupDebug 
# Assume we are not using Tk
set Tk 0
set v 0

# Clear the flags..
foreach val $legalmin {
  set $val 0
}
#
# echo only if verbose but if Tk always keep up the status...
#
proc echo {mess} {
  if {$::v} {
    puts "$mess"
  }
  if {$::Tk} {
    $::w insert end "$mess\n"
    $::w see end
  }     
}

proc setDefault {loc } {
  foreach addr $::legal loc $loc {
    set ::add($addr) $loc
  }
}

# Move to the code source dir
cd $HomeDir
set gui 0
setDefault $rootloc

# Check env vars ...
foreach ent $legal {
  if {[info exists env($ent)]} {
    set add($ent) $env($ent)
  }
}
# Check the run time arguments...

set changelist {}  ; # list of changed options
foreach ent $argv {
  lassign [split $ent "-"] arg val ext
  if {$arg == {} } {
    # The following allows '--' instead of just '-'
    if {$val == {} } {set val $ext}
    if {$val ni $legalmin } {
      puts "Bad argument \"$ent\". Must be one of $legalmin."
      exit
    }
    set $val 1
    lappend changelist $val
    switch $val {
      test    {set verbose 1}
      testdir {set add(DESTDIR) ./TEST}
      gui     {set nogui 0}
      nogui   {set gui 0}
      h       {set help 1}
    }
    continue
  }
  lassign [split $ent "="] arg val
  if {$arg ni $legal} {
    puts "Bad argument \"$ent\". Must be one of $legal=path"
    exit 1
  }
  set add($arg) $val
  lappend changelist $arg
}

set add(FRLIB) $add(CODE)/frlib

if {!$root && $add(DESTDIR) == {}} {
  if {"prefix" ni $changelist} {
    set add(prefix) [file normalize ~/.local/share]
  }
  if {"EXEC" ni $changelist} {
    set add(EXEC) [file normalize ~/bin]
  }
  if {"gui" ni $changelist} {
    set gui 1
  }
}
# Move the verbose option

set v $verbose

# This proc returns true if we can write to the file given, even
# if it does not exist (as long as we can create it and its path)
#
proc canWrite { fname } {
  if {$fname == {}} { return 1}
  set fl [file normalize $::add(DESTDIR)$fname]
  while {![file exists $fl]} {
    if {$fl == "/"} {break}
    set fl [file dirname $fl]
  }
  return [file writable $fl]
}

proc sumrize {mess} {
  echo "$mess"
  set m 0
  echo "prefix=$::add(prefix)"
  echo "DESTDIR=$::add(DESTDIR)"
  echo "\nGiving the following addresses:\n"
  foreach d [lrange $::legal 2 end] {
    if {$d in $::prefixed && $::add($d) != {}} {
      set fl $::add(DESTDIR)[file join $::add(prefix) $::add($d)]
      set flag [expr {[canWrite $fl] ? {} : {(*)}}]
      echo "$d=$fl$flag"
    } else {
      if {$::add($d) == {} || [canWrite $::add(DESTDIR)$::add($d)] } {
	set flag {}
      } else {
	set flag "(*)" 
      }
      echo "$d=$::add(DESTDIR)$::add($d)$flag"
    }
    if {$flag != {}} {set m 1}     
  }
  if {$m} {
    echo "\nStarred (*) paths above are not writable by you!"
  }
}

if {$help} {
  puts "
        This is the install program for filerunner. 

        If run by user root it will default to running quietly and 
        just do the install.  

        If run as any other user it will default to GUI mode (if Tk is present)
        unless DESTDIR is set.

        The following options may be changed on the command line by entering
        the item being changed followed by '=<new path>' 
        for example:

        prefix=/opt/share 

        If any of the entries used with prefix are absolute path names they
        will not use the prefix.

        If any of the entries are blank, that item will not be installed.
        "
  foreach op $legal hlp $legalhelp {
    puts "[format {    %8s %s} $op $hlp]"
  }
  puts "
        DESTDIR is ONLY useful if the whole install is to be move before
        running filerunner.  Its main (only) usage is to build package
        files (such as the RPM package).
       "
  puts "
        The following '-' options change the install behavior as indicated:
       "
  foreach op $legalmin hlp $legalmhelp {
    puts "[format {   -%-8s %s} $op $hlp]"
  }
  set v 1
  sumrize "\nCurrent install locations after run string processing are:\n"
  return
}
if {$gui} {
  set Tk [expr [catch {package require Tk} out]  != 0 ? 0 : 1]
  frputs "Request Tk  " out
  #set Tk 0 ;#debug line....
  if {$Tk } {
    wm title . "Install Status"
    wm iconname . "Install Status"
    wm geometry . 566x342+31+10
    set w .text
    text $w -yscrollcommand ".scroll set" -wrap word
    scrollbar .scroll -command "$w yview" 
    grid $w  -row 0 -column 0 -in . -sticky nswe
    grid .scroll -row 0 -column 1 -in .  -sticky nse 
    grid rowconfigure . 0 -weight 1
    grid columnconfigure . 0 -weight 1
   }
}
# build a list of addresses as of now...
foreach d $legal {
  lappend runtimeloc $::add($d)
}

sumrize "After run string processing we have:"
setDefault $runtimeloc	
# 
# We require Tk to have a meaningful dialog here.  
# If no Tk check if we should just plow ahead or ask for a 
# by your leave...
#
if {$Tk} {	 
  set ans [smart_dialog .ask . {What to do?} \
	       [list \
		    "These are the locations where the various parts of filerunner will be installed.\
                    \nThe install location' (below) will prefix all but the 'Link to fr location'\
                    \nunless those locations are absolute addresses (i.e. they start with '/'.\
                   \n \
                   \nNote that the 'Config file location' starts at the\
                     system config file location.\
                   \nAn empty location (i.e. all blank) will cause those\
                     items to not be installed.\n\
                   \nYou may omit the desktop and icons or not and you\
                     may put a run link in or not.\n\
                    \nIf you check the 'Don't move filerunner' box \
                     filerunner will be left in its \
                    \ncurrent location.  This affects both the code and \
                     documentation. The rest\
                    \ndepend on the addresses here."]  6 12\
	       [list [list "Pseudo install location" {-textvariable add(DESTDIR)}]\
		    [list "Install location" {-textvariable add(prefix)}] \
		    [list "Code location" {-textvariable add(CODE) -width 55}]\
		    [list "Document location" {-textvariable add(DOCS)}]\
		    [list "Config file location" {-textvariable add(GCONFIG)}]\
		    [list "Icon location"     {-textvariable add(ICON)}]\
		    [list "Desk top location"  {-textvariable add(DESKTOP)}]\
		    [list "Link to fr location" {-textvariable add(EXEC) }]\
		    [list "Don't move filerunner" \
			 {-command "set add(CODE) {} ; set add(DOCS) {}"}]\
		    [list "Reset" {-command "setDefault \$::runtimeloc"}]\
		    "OK" "Exit"]]
  if {$ans == 11} {exit 1}
  sumrize "After dialog we have:"
} else {
  if {$ask} {
    if {!$v} {
      set v 1
      sumrize "Install will be to these locations:"
      set v 0
    }
    set tf [expr {$test ? { TEST} : {}}]
    puts -nonewline "\nOk to$tf install to the above locations? (Y/n)"
    flush stdout
    set in [gets stdin]
    #puts ">$in<"
    if {$in != "Y" && $in != "y"} {exit 1}
  }
} 

# OK we have all the bits and pieces lets make convenient names...
set DESTDIR [file normalize $::add(DESTDIR)]
#puts "DESTDIR = $DESTDIR"
foreach ent [lrange $legal 2 end] {
  if {$::add($ent) == {} } {
    set $ent {}
  } elseif {$ent in $::prefixed} {
    set $ent [file normalize [file join $::add(prefix) $::add($ent)]]
  } else {
    set $ent [file normalize $::add($ent)]
  }
  #puts "$ent = [set $ent]"
}
# Here are a few work horse procs...

proc recur_set_att {dir att} {
  foreach file [glob -nocomplain -type f $dir/*] {
    echo "attributes $file $att"
    file attributes $file -permissions $att
  }
  foreach dirb [glob -type d -nocomplain $dir/*] {
    recur_set_att $dirb $att
  }
}

# This routine eliminates any links in the copy and thus copies the real file
# Dirs are handeled recursively...

# first the simple case ... not a dir
# if "to" is not a dir then if "file dir $to" must be a dir and is created if needed

proc resolveLink {file} {
  # Much easier and more correct (for multi links)
  return [file dir [file norm $file/x]]
  # set r [catch {file link $file} frn]
  # if {$r != 0} {
  #   set frn $file
  # } else {
  #   set frn [file norm [file join [file dir $file] $frn]]
  # }
  # return $frn
}

proc fileCopyNoLinkSimple {from to} {
  if {[file isdir $from]} {
    error "fileCopyNoLinkSimple called with a directory ($from)."
  }
  file mkdir $to
  # We fix the file tail name incase the resolveLink changes the source
  set to $to/[file tail $from]
  set frn [resolveLink $from]
  echo "copy $frn $to"
  file copy -force $frn  $to
}

proc fileCopyNoLink {from to {mask *} } {
  if {![file isdir $from]} {
    return [fileCopyNoLinkSimple $from $to]
  }
  # The following line allows us to exclude directories for other platforms
  if {[file exists $from/.notunix]} {return}
  if {[file exists $to] && [file isfile $to]} {
    error "fileCopyNoLink called with directory source and file destination. \
           \n from is $from and to is $to"
  }
  foreach fil [glob -type f -directory $from -nocomplain -tails {*}$mask] {
    fileCopyNoLinkSimple $from/$fil $to/[file tail $from]
  }
  foreach dir [glob -type d -directory $from -nocomplain -tails *] {
    fileCopyNoLink $from/$dir $to/[file tail $from] $mask
  }
}

# This code is always dir or file to dir...
# Never file to file
# from may be list of dirs or files, to is always a dir.

proc copy {from to {att {}}  {mask *}} {
  if {[file exists $to] && ![file isdir $to]} {
    error "copy called with a non-dir target."
  }
  set to $::DESTDIR$to
  if {!$::test} {
    file mkdir $to
  }
  foreach file $from {
    if {!$::test} {
      fileCopyNoLink $file $to $mask
    }
    if {$att != {} } {
      if {[file isfile $file]} {
	echo "attributes $to/$file $att"
	if {!$::test} {
	  if {[file  isdirectory $to]} {
	    file attributes $to/$file -permissions $att
	  } else {
	    file attributes $file -permissions $att
	  }
	}
      } else {
	echo "recursive set att $to/[file tail $from]"
	if {!$::test} {
	  recur_set_att $to/[file tail $from] $att
	}
      }
    }
  }
}
# Before we get to work, check out each dir we want to write to
# and make sure we can...
set fail 0
foreach d [lrange $::legal 2 end] {
  if {$d != {}} {
    if {! [canWrite $d]} {
      # allow a user to use a protected config file as long as it exists
      if {$d == "GCONFIG" && \
	      $DISTDIR == {} && \
	      [file exists $d/filerunnerrc]} {continue}
      set v 1
      echo "Oops! Can not write to $d"
      set fail 1
    }
  }
}
if {$fail} {
  echo "Fix the above and try again."
  if {!$Tk} { exit 1}
  return
}

set v $verbose
# build the uninstall file as we go along...
foreach ex {TMP TMPDIR} {
  if {[info exists env($ex)]} {
    lappend tmplist $env($ex)
  }
}
lappend tmplist "/tmp"

set tmpdir {}

foreach tmpdir $tmplist {
  set tmpdir [file normalize $tmpdir]
  if {[file isdirectory $tmpdir] } {break}
}

if {$tmpdir == {}} {
  echo "Could not find a tmp dir in enviroment. Looked for:\
       \nTMP and TMPDIR\
       \nPlease fix this..."
  exit 1
}

if {!$test && $DESTDIR == {}} {
  # look for an existing uninstall file...
  if {[file executable $CODE/uninstall] } {
    echo "Found uninstall file for old fr. Doing the uninstall."
    exec $CODE/uninstall
  }
  set unfid [open $tmpdir/uninstall w]
  puts $unfid "#!/bin/sh

# This is the filerunner uninstall routine.
# It uses all absolute file address so may be used 
# from any location"
  proc putun {what} {
    puts $::unfid "$what"
  }
} else {
  proc putun {x} {return}
}

# copy the tcl files...

if {$CODE != {}} {
  copy [glob -type f "*.tcl"]  $CODE {rw-r--r--}

  copy tclIndex $CODE {rw-r--r--}

  # copy the executables  fr frftp 

  copy {fr frftp} $CODE {rwxr-xr-x}

  #copy frlib...
  file delete -force $DESTDIR$CODE/frlib
  copy frlib $CODE {rw-r--r--} *.tcl 

  # copy the support files.. bitmaps/*, packages/*
  file delete -force $DESTDIR$CODE/bitmaps
  file delete -force $DESTDIR$CODE/packages
  # The masks below take advantage of the multilpe pattern feature of glob
  # and help us exclude working files, old versions  and such
  # These, of course, will not exist on a pure tar.gz, but who has such?
  copy bitmaps $CODE {rw-r--r--}  {*.bit bitmapeditor}
  copy packages $CODE {rw-r--r--} {*.tcl .*.tcl *.so .tkconrc tclIndex}

  foreach dir [glob -nocomplain -path $CODE/packages/ -type d "*"] {
    if { [catch "file link $dir"] == 0 } {
      file delete -force $dir
    }
  }
  
  # clean up the inotify issue.  We have three possible cases:
  # 1. This arch has a binary for inotify or
  # 2. it does not.
  # 3. It is a package build and the package code will do the work
  #
  # All of this is handled by the trim-inotify.tcl code which we
  # Install here:
  cd $HomeDir/Makefiles
  if {$DESTDIR == {}} {
    copy trim-inotify.tcl $CODE {r-xr-xr-x}
    copy [glob *-inotify-*]  $CODE/Makefiles {r--r--r--}
    copy build_inotify  $CODE/Makefiles {r-xr-xr-x}
  }
  # and, one more thing.  We write a config file for here
  # it contains the doc dir and a command to source the 
  # config file filerunnerrc
  # If filerunnerrc exist, we leave it alone, otherwise we 
  # make a blank one...
  echo "Building the 'CODE' local configure file"
  if {!$test} {
    set fid [open $DESTDIR$CODE/config w]
    puts $fid "# This file is generated by filerunner INSTALL"
    puts $fid "# It points out the DOC directory and the system"
    puts $fid "# configure file (filerunnerrc)."
    puts $fid "#"
    puts $fid "set ::glob(doclib_fr) $DOCS"
    puts $fid "if {\[file readable $GCONFIG/filerunnerrc]} \
             {source $GCONFIG/filerunnerrc}"
    puts $fid ""
    close $fid
  }
  if {$DESTDIR != {}} {
    echo "Defering the SYSTEM configure file to package script"
  } else {
    echo "Building the 'SYSTEM' configure file"
    if {![file exist $GCONFIG/filerunnerrc] } {
      if {!$test} {
	file mkdir $GCONFIG
	set fid [open $GCONFIG/filerunnerrc w]
	puts $fid "# Put global filerunner configure stuff here"
	close $fid
      }
    } else {
      echo "SYSTEM configure file already exists.  Doing nothing."
    }
    putun "rm -rf $CODE"
  }
  cd $HomeDir
}
# copy the doc files.  
# copy all files except those with ~ at the end

if {$DOCS != {}} {
  cd $HomeDir/doc
  copy [glob -type f {*[!-z]} ] $DOCS {r--r--r--}
  putun "rm -fr $DOCS"
}

# copy the icons
if {$ICON != {}} {
  set todir $DESTDIR$ICON
  cd $HomeDir/icons
  foreach file [glob filerunner*.png] {
    regexp {filerunner-([^.]*)\.png} $file mat subdir
    file mkdir $todir/$subdir/apps
    file copy -force [resolveLink $file] $todir/$subdir/apps/filerunner.png
    file attributes $todir/$subdir/apps/filerunner.png -permissions {r--r--r--}
    putun "rm -f $todir/$subdir/apps/filerunner.png"
  }
}
if {$DESKTOP != {} } {
  cd $HomeDir/Makefiles
  # copy the desktop file
  copy filerunner.desktop $DESKTOP {rw-r--r--}
  putun "rm -f $DESKTOP/filerunner.desktop"
}
cd $HomeDir
# set up the /bin/fr link
echo "Setting up symbolic link in $EXEC/fr"
if {!$test} {
  if {$add(CODE) == {} } {
    set target [file normalize ./fr]
  } else {
    set target $::DESTDIR$CODE/fr
  }
  file mkdir $::DESTDIR$EXEC
  echo "made $::DESTDIR$EXEC"
  # This MUST be a relative link or it will fail in the DESTDIR case
  # And, the tcl file command does not do relative :(
  # But darn, some versions of ln do not handle relative...
  file delete -force $::DESTDIR$EXEC/fr
  if {$::DESTDIR == {}} {
    set r [catch {exec ln -sf $target $::DESTDIR$EXEC/fr} out]
    set fl {}
  } else {
    set r [catch {exec ln -sfr $target $::DESTDIR$EXEC/fr} out]
    set fl r
  }
  #set r [catch {file link -symbolic $::DESTDIR$EXEC/fr $target} out]
  if {$r != 0 } {
    set sterror(2) "Error setting up link to fr: $out with command:
ln -sf$fl $target $::DESTDIR$EXEC/fr"
    echo $sterror(2)
  } else {
    putun "rm -f $add(EXEC)/fr"
  }
  
  # if this is a 'package' install, do not produce the uninstall file
  # rather leaving that to the package code.
  if {$::DESTDIR == {}} {    
    close $unfid
    if {$add(CODE) != {} } {
      set undir $CODE
      set unfil uninstall
      # here we fix up the inotify code by calling the planted agent.
      cd $CODE
      #puts "[pwd]"
      exec ./trim-inotify.tcl
    } else {
      set undir [pwd]
      set unfil uninstall
      while {[file exists $unfil] } {
	set unfil uninstall_[incr foo]
      }
      echo "Not installing CODE means default uninstall file will be put
          in the current directory.  It will have name: $unfil"
      file rename -force $tmpdir/uninstall $tmpdir/$unfil
    }
    echo "Moving the uninstall file to $undir/$unfil"
    cd $tmpdir
    copy $unfil $undir {rwxr-xr-x}
  }
}
if {[info exists sterror]} {
  set sv $::v
  echo "The following errors were found:"
  foreach pos {1 2 3 4 5 6} {
    if {[info exists sterror($pos)]} {
      echo "$sterror($pos)"
    }
  }
  echo "However, otherwise the INSTALL seems to have worked."
  set ::v $sv
}
if {!$Tk} {
  exit 0
}
echo "\nDone -------------- Close this window when you like"
# if Tk let him just close the window


