pkgr_upload.eagle at [2515a3ade8]
Not logged in

File client/1.0/neutral/pkgr_upload.eagle artifact 06d64b587a part of check-in 2515a3ade8


###############################################################################
#
# pkgr_upload.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Repository Client (Upload Tool)
#
# Copyright (c) 2007-2012 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################

#
# NOTE: Use our own namespace here because even though we do not directly
#       support namespaces ourselves, we do not want to pollute the global
#       namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::PackageUploader {
  #
  # NOTE: This procedure is used to report errors that prevent this tool
  #       from running to completion (e.g. invalid command line arguments,
  #       etc).  It may be used to report a specific error.  It will always
  #       emit the command line usage information.
  #
  proc usage { {error ""} } {
    if {[string length $error] > 0} then {puts stdout $error}

    puts stdout "usage:\
  [file tail [info nameofexecutable]]\
  [file tail [info script]] \[apiKey\] \[name\] \[version\] \[language\]\
  \[fileName1\] ... \[fileNameN\]"

    exit 1
  }

  #
  # NOTE: This procedure returns a string value, formatted for use within a
  #       script block being processed by the [string map] command.  The
  #       value argument is the string value to format.  No return value is
  #       reserved to indicate an error.  This procedure may not raise any
  #       script errors.
  #
  proc formatStringMapValue { value } {
    if {[string length $value] == 0} then {
      return \"\"
    }

    set list [list $value]

    if {$value eq $list} then {
      return $value
    } else {
      return $list
    }
  }

  #
  #
  #
  proc getContainingDirectory { fileNames } {
    set result ""
    set resultParts [list]

    foreach fileName $fileNames {
      set directory [file dirname $fileName]
      set directoryParts [file split $directory]

      if {[llength $resultParts] == 0 || \
          [llength $directoryParts] < [llength $resultParts]} then {
        set result $directory
        set resultParts $directoryParts
      } elseif {[llength $directoryParts] == [llength $resultParts] && \
          $directory ne $result} then {
        set result [file dirname $directory]
        set resultParts [file split $result]
      }
    }

    return $result
  }

  #
  #
  #
  proc getScriptChunkForFileNames { fileNames maximumLevels } {
    set directory [getContainingDirectory $fileNames]
    set directoryParts [file split $directory]
    set fileNameIndex [expr {[llength $directoryParts] - 1}]

    if {$fileNameIndex < 0} then {
      error [appendArgs \
          "bad file name index"]
    }

    set relativeFileNames [list]

    foreach fileName $fileNames {
      set fileNameParts [lrange [file split $fileName] $fileNameIndex end]

      if {$maximumLevels > 0 && \
          [llength $fileNameParts] > $maximumLevels} then {
        error [appendArgs \
            "depth for file name \"" $fileName \
            "\" exceeds maximum (" $maximumLevels )]
      }

      set relativeFileName [eval file join $fileNameParts]

      if {[string length $relativeFileName] == 0 || \
          [file pathtype $relativeFileName] ne "relative"} then {
        error [appendArgs \
            "bad file name \"" $relativeFileName "\", not relative"]
      }

      lappend relativeFileNames $relativeFileName
    }

    set result ""

    foreach relativeFileName $relativeFileNames {
      if {[string length $result] > 0} then {
        append result \n
      }

      append result {  lappend fileNames [file join }
      append result [file split $relativeFileName]
      append result \]
    }

    return $result
  }

  #
  #
  #
  proc createRepositoryScript { language version platform fileNames options } {
    return [string trim [string map [list \r\n \n \
        %language% [formatStringMapValue $language] \
        %version% [formatStringMapValue $version] \
        %platform% [formatStringMapValue $platform] \
        %backslash% \\ %ns% ::PackageDownloader %fileNames% \
        [getScriptChunkForFileNames \
        $fileNames 2]] {
apply [list [list] {
  package require Eagle.Package.Downloader

  %ns%::resetCookieAndLoginSimple

  set fileNames [list]

%fileNames%

  set options [list %backslash%
      -persistent false -usePgp true -useAutoPath true]

  %ns%::downloadFiles %language% %version% %platform% $fileNames $options
  %ns%::logoutAndResetCookie
}]
    }]]
  }

  #
  # NOTE: Figure out the fully qualified path to the current script file.
  #       If necessary, add it to the auto-path for the interpreter.  The
  #       necessary supporting packages (i.e. the Package Repository and
  #       other support packages) that are assumed to exist in the same
  #       directory as the current script file.
  #
  variable pkgr_path; # DEFAULT: <unset>

  if {![info exists pkgr_path]} then {
    set pkgr_path [file normalize [file dirname [info script]]]

    if {![info exists ::auto_path] || \
        [lsearch -exact $::auto_path $pkgr_path] == -1} then {
      lappend ::auto_path $pkgr_path
    }
  }

  #
  # NOTE: *TODO* Pre-create the namespace for the Package Repository Client
  #       package and then forcibly adjust various settings to the values
  #       necessary for this tool.  In the future, this section may need to
  #       be tweaked to account for changes to the Package Repository Client
  #       package.
  #
  namespace eval ::PackageRepository {
    variable verboseUriDownload true
  }

  #
  # NOTE: Load the Package Repository Client package now.
  #
  package require Eagle.Package.Repository

  #
  # NOTE: Verify that the number of command line arguments meets the basic
  #       requirements of this tool.
  #
  if {[info exists ::argv] && [llength $::argv] >= 5} then {
    #
    # NOTE: All the necessary arguments were supplied on the command line,
    #       use batch mode.
    #
  } else {
    #
    # NOTE: One or more of the necessary arguments were not supplied on the
    #       command line, use interactive mode.  This will create a graphical
    #       user interface, using Tk or WinForms.  If any of the necessary
    #       arguments were supplied on the command line, they will be used to
    #       populate those fields on the graphical user interface.
    #
    if {[isEagle]} then {

    } else {

    }
  }
}