[PATCH] Don't emit sh commands in gst-package.in

Just execute them using File/Directory and the newly introduced bindings
to mkdtemp and chmod.  Only zip is executed using #system:.

Paolo

* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-442 to compare with
* auto-adding [hidden email]--2004b/smalltalk--devo--2.2--patch-442 to greedy revision library /Users/bonzinip/Archives/revlib
* found immediate ancestor revision in library ([hidden email]--2004b/smalltalk--devo--2.2--patch-441)
* patching for this revision ([hidden email]--2004b/smalltalk--devo--2.2--patch-442)
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-442
M  scripts/Package.st
M  configure.ac
M  gst-package.in
M  ChangeLog

* modified files

--- orig/gst-package.in
+++ mod/gst-package.in
@@ -63,7 +63,6 @@ getopt () {
 getopt "$@" | {
   load_dry_run=-n
   load_test=
-  list=false
   run_cmd=eval
   files=
   srcdir=
@@ -74,8 +73,8 @@ getopt "$@" | {
       --load) load_dry_run= ;;
       --test) load_test=--test ;;
       --dry-run) run_cmd=: ;;
-      --list-files) list=: ;;
-      --list-packages) list=: ;;
+      --list-files) run_cmd=: ;;
+      --list-packages) run_cmd=: ;;
       --srcdir) srcdir=$arg ;;
       --image-file)
  test x${image_file:+set} = xset && show_help --bad
@@ -86,16 +85,12 @@ getopt "$@" | {
 
   set -e
 
-  if $list; then
-    gst scripts/Package.st "$@"
-  else
-    INSTALL='@INSTALL@' LN_S='@LN_S@' ZIP='@ZIP@' gst scripts/Package.st "$@" | sh
+  INSTALL='@INSTALL@' LN_S='@LN_S@' XZIP='@ZIP@' gst scripts/Package.st "$@"
 
-    if test "$run_cmd" = eval && test "$load_test,$load_dry_run" != ,-n; then
-      packages=`eval gst scripts/Package.st \
- ${srcdir:+"--srcdir=$srcdir"} \
+  if test "$run_cmd" = eval && test "$load_test,$load_dry_run" != ,-n; then
+    packages=`eval gst scripts/Package.st \
+ ${srcdir:+"--srcdir=$srcdir"}
  --list-packages "$files" `
-      gst scripts/Load.st $load_dry_run $load_test $packages
-    fi
+    gst scripts/Load.st $load_dry_run $load_test $packages
   fi
 }


--- orig/scripts/Package.st
+++ mod/scripts/Package.st
@@ -129,34 +129,91 @@ Kernel.PackageDirectories subclass: Pack
 
 File extend [
     emitZipDir: dir [
+ | saveDir |
  self emitRemove.
- ('cmd %1 \$ZIP -qr %2 .' % { dir. self }) displayNl
+ ('cd %1 && %2 -qr %3 .' % { dir. Command zip. self }) displayNl.
+        saveDir := Directory working.
+ Command
+    execute: [
+        Directory working: dir name.
+ Smalltalk system: '%1 -qr %2 .' % { Command zip. self }
+    ]
+    ensure: [ Directory working: saveDir ]
     ]
 
     emitRemove [
- ('cmd . rm -f %1' % { self }) displayNl
+ ('rm -f %1' % { self }) displayNl.
+ Command execute: [
+    self exists ifTrue: [ self remove ] ].
     ]
 
     emitSymlink: dest [
- ('cmd . \$LN_S -f %1 %2' % { self. dest }) displayNl
+ | destFile |
+ ('%1 -f %2 %3' % { Command symLink. self. dest }) displayNl.
+ Command execute: [
+    destFile := File name: dest.
+    destFile exists ifTrue: [ destFile remove ].
+    self symlinkAs: dest ].
     ]
 
     emitInstall: dest [
- | mode |
+ | destFile srcStream destStream mode |
  mode := self isExecutable ifTrue: [ 8r755 ] ifFalse: [ 8r644 ].
- ('cmd . \$INSTALL -m %1 %2 %3'
-    % { mode printString: 8. self. File name: dest }) displayNl
+ destFile := File name: dest.
+ ('%1 -m %2 %3 %4' % {
+    Command install. self. mode printString: 8. destFile })
+ displayNl.
+ Command
+    execute: [
+        destFile exists ifTrue: [ destFile remove ].
+        srcStream := self readStream.
+ destStream := destFile writeStream.
+        destStream nextPutAll: srcStream.
+    ]
+    ensure: [
+ destStream isNil ifFalse: [ destStream close ].
+ srcStream isNil ifFalse: [ srcStream close ].
+ destFile mode: mode
+    ].
     ]
 ]
 
 Directory extend [
     emitMkdir [
- ('cmd . \$mkdir_p %1' % { self }) displayNl
+ | doThat |
+ self exists ifTrue: [ ^self ].
+ Command execute: [ (Directory name: self path) emitMkdir ].
+ ('mkdir %1' % { self }) displayNl.
+ Command execute: [ Directory create: self name ].
     ]
 ]
 
 Object subclass: Command [
-    | packages installDir dryRun copy allFiles |
+    | packages installDir copy allFiles |
+
+    DryRun := false.
+    Command class >> execute: aBlock [
+ DryRun ifFalse: [ aBlock value ]
+    ]
+    Command class >> execute: aBlock ensure: ensureBlock [
+ DryRun ifFalse: [ aBlock ensure: ensureBlock ]
+    ]
+    Command class >> dryRun [
+ ^DryRun
+    ]
+    Command class >> dryRun: aBoolean [
+ DryRun := aBoolean
+    ]
+
+    Command class >> zip [
+ ^(Smalltalk getenv: 'XZIP') ifNil: [ 'zip' ]
+    ]
+    Command class >> install [
+ ^(Smalltalk getenv: 'INSTALL') ifNil: [ 'install' ]
+    ]
+    Command class >> symLink [
+ ^(Smalltalk getenv: 'LN_S') ifNil: [ 'ln -s' ]
+    ]
 
     validateDestDir: destdir installDir: instDir [
  instDir isNil ifTrue: [ ^self ].
@@ -167,16 +224,14 @@ Object subclass: Command [
 
     destDir: destdir installDir: instDir [
  self validateDestDir: destdir installDir: instDir.
- instDir isNil
-    ifTrue: [ installDir := destdir, self defaultInstallDir ]
-    ifFalse: [ installDir := destdir, instDir ]
+ installDir :=
+    Directory name:
+        destdir, (instDir ifNil: [ self defaultInstallDir ])
     ]
 
     defaultInstallDir [ ^Directory image ]
     installDir [ ^installDir ]
 
-    dryRun [ ^dryRun ]
-    dryRun: aBoolean [ dryRun := aBoolean ]
     copy [ ^copy ]
     copy: aBoolean [ copy := aBoolean ]
     allFiles [ ^allFiles ]
@@ -205,7 +260,7 @@ Object subclass: Command [
 
     listFiles: listFiles vpath: aBoolean [
  | base vpathBase |
- base := Directory name: self installDir.
+ base := self installDir.
  vpathBase := Directory name: self srcdir.
 
         listFiles do: [ :each || package |
@@ -221,124 +276,7 @@ Object subclass: Command [
     ]
 ]
 
-Command subclass: ShellCommand [
-    emitVariable: aString default: command [
- ('%1="%2"' % { aString. (Smalltalk getenv: aString) ifNil: [ command ] })
-    displayNl.
-    ]
-
-    prolog [
- ('run_cmd=%<:|eval>1' % { dryRun }) displayNl.
- self emitVariable: 'INSTALL' default: 'install-sh'.
- self emitVariable: 'LN_S' default: 'ln -s'.
- self emitVariable: 'ZIP' default: 'zip'.
-
- stdout nextPutAll:
-'case "$INSTALL" in
-  */install-sh | *"/install-sh -c" | \
-  */install.sh | *"/install.sh -c" | \
-  install-sh | "install-sh -c" | \
-  install.sh | "install.sh -c")
-    display_INSTALL=install
-    INSTALL=func_install
-    ;;
-  *)
-    display_INSTALL="$INSTALL"
-    ;;
-esac
-
-# Simplistic replacement for the install package, used when
-# configure chose the install-sh script
-func_install ()
-{
-  while [ $# -gt 4 ]; do
-    shift
-  done
-  set -e
-  rm -f "$4"
-  cp "$3" "$4"
-  chmod $2 "$4"
-  set +e
-}
-
-# mkdir -p emulation based on the mkinstalldirs script.
-mkdir_p ()
-{
-  for file
-  do
-    case $file in
-      /*) pathcomp=/ ;;
-      *)  pathcomp= ;;
-    esac
-    oIFS=$IFS
-    IFS=/
-    set fnord $file
-    shift
-    IFS=$oIFS
-
-    errstatus=0
-    for d
-    do
-      test "x$d" = x && continue
-      pathcomp=$pathcomp$d
-      case $pathcomp in
-        -*) pathcomp=./$pathcomp ;;
-      esac
-
-      if test ! -d "$pathcomp"; then
-        mkdir "$pathcomp" || lasterr=$?
-        test -d "$pathcomp" || errstatus=$lasterr
-      fi
-      pathcomp=$pathcomp/
-    done
-  done
-  return "$errstatus"
-}
-
-cmd () {
-  (dir="$1"
-  shift
-  save_INSTALL=$INSTALL
-  INSTALL=$display_INSTALL
-  mkdir_p="mkdir -p"
-  case "$dir" in
-    .) eval echo "$@" ;;
-    *) eval echo cd $dir \\\&\\\& "$@" ;;
-  esac
-  INSTALL=$save_INSTALL
-  mkdir_p=mkdir_p
-  eval cd "$dir"
-  $run_cmd "$@")
-}
-
-mkdtemp () {
-  # Create a temporary directory $tmp in $TMPDIR (default /tmp).
-  # Use mktemp if possible; otherwise fall back on mkdir,
-  # with $RANDOM to make collisions less likely.
-  : ${TMPDIR=/tmp}
-
-  for i in 1 2 3 4 5 6 7 8 9 10; do
-    if test $i = 1 && test "$run_cmd" != :; then
-      tmp=`(umask 077 && mktemp -d "$TMPDIR/gstar-XXXXXX") 2>/dev/null`
-    else
-      tmp=$TMPDIR/foo$$-$RANDOM
-      test "$run_cmd" != : && break
-      mkdir -m700 "$tmp" 2>/dev/null
-    fi
-    result=$?
-    test -n "$tmp" && test -d "$tmp" && break
-    test $i = 10 && exit $?
-  done
-  trap "rm -rf \"\$tmp\"" 0 1 2 3 15
-  echo "mkdir -m700 \"$tmp\""
-}
-
-set -e
-'.
-    ]
-]
-
-ShellCommand subclass: PkgDist [
+Command subclass: PkgDist [
     validateDestDir: destdir installDir: instDir [
  (destdir isEmpty and: [ instDir isNil ]) ifTrue: [
     self error: 'using --dist without specifying --distdir' ].
@@ -365,9 +303,8 @@ ShellCommand subclass: PkgDist [
     distribute: srcFile as: file in: dir [
  | destName baseDir |
  baseDir := self installDir.
- dir isNil ifFalse: [
-    baseDir := Directory append: dir to: baseDir ].
- destName := Directory append: file to: baseDir.
+ dir isNil ifFalse: [ baseDir := baseDir directoryAt: dir ].
+ destName := baseDir nameAt: file.
  copy
     ifTrue: [ srcFile emitInstall: destName ]
     ifFalse: [ srcFile emitSymlink: destName ]
@@ -387,8 +324,7 @@ ShellCommand subclass: PkgDist [
  Directory append: dir to: aPackage relativeDirectory ] ].
 
         dirs do: [ :dir || destName |
-    destName := Directory append: dir to: self installDir.
-    (Directory name: destName) emitMkdir ].
+    (self installDir directoryAt: dir) emitMkdir ].
 
         files do: [ :file || srcFile destName |
     srcFile := File name: (aPackage findPathFor: file).
@@ -399,46 +335,65 @@ ShellCommand subclass: PkgDist [
     ]
 ]
 
-ShellCommand subclass: PkgInstall [
+Command subclass: PkgInstall [
+    | tmpDir |
+
     run [
         "Create the installation directory."
-        (Directory name: self installDir) emitMkdir.
- super run.
+        self installDir emitMkdir.
+ [ super run ] ensure: [
+    tmpDir isNil ifFalse: [ tmpDir remove ] ]
+    ]
+
+    tmpDir [
+ tmpDir isNil ifTrue: [
+            tmpDir := Directory createTemporary: Directory temporary, '/gstar-'.
+            ('mkdir %1' % { tmpDir }) displayNl ].
+ ^tmpDir
     ]
 
     runOnPackage: aPackage [
  | pkg destFile dirs files baseDir |
-        'mkdtemp' displayNl.
- baseDir := '\"\$tmp\"/%1' % { aPackage name }.
+ baseDir := self tmpDir directoryAt: aPackage name.
  pkg := aPackage copy.
  pkg relativeDirectory: nil.
 
- ('cmd . \$mkdir_p ', baseDir) displayNl.
- ('$run_cmd cat \> %1/package.xml << ''__<EOF>__''
-%2
-__<EOF>__' % { baseDir. pkg }) displayNl.
-
- files := pkg allFiles.
-        dirs := files collect: [ :file | File pathFor: file ].
- dirs asSet asSortedCollection do: [ :dir |
-    ('cmd . \$mkdir_p %1/%2' % { baseDir. dir }) displayNl ].
-
-        files do: [ :file || srcFile destName |
-    srcFile := File name: (aPackage findPathFor: file).
-    ('cmd . \$LN_S -f %1 %2/%3' % { srcFile. baseDir. file }) displayNl ].
-
- destFile := Directory append: aPackage name, '.star' to: self installDir.
- (File name: destFile) emitZipDir: baseDir.
+ baseDir emitMkdir.
+ Command
+    execute: [
+        (baseDir fileAt: 'package.xml') withWriteStreamDo: [ :s |
+            pkg printOn: s ].
+
+        files := pkg allFiles.
+                dirs := files collect: [ :file | File pathFor: file ].
+        dirs asSet asSortedCollection do: [ :dir |
+            (baseDir directoryAt: dir) emitMkdir ].
+
+                files do: [ :file || srcFile |
+            srcFile := File name: (aPackage findPathFor: file).
+            srcFile emitSymlink: (baseDir nameAt: file) ].
+
+        (self installDir fileAt: aPackage name, '.star')
+    emitZipDir: baseDir
+    ]
+    ensure: [
+        "Clean up our mess."
+        (baseDir fileAt: 'package.xml') remove.
+                files do: [ :file |
+            (baseDir fileAt: file) remove ].
+        dirs asSet asSortedCollection do: [ :dir |
+            (baseDir directoryAt: dir) remove ]
+    ].
     ]
 
     runOnStar: aPackage [
  | destFile |
- destFile := Directory append: aPackage name, '.star' to: self installDir.
+ destFile := self installDir nameAt: aPackage name, '.star'.
  (File name: aPackage starFileName) emitInstall: destFile.
     ]
 ]
 
-ShellCommand subclass: PkgUninstall [
+Command subclass: PkgUninstall [
     run [
         super run.
         packages filesDo: [ :each | (File name: each) emitRemove ]
@@ -447,11 +402,11 @@ ShellCommand subclass: PkgUninstall [
     runOnPackage: aPackage [
  | baseDir |
  baseDir := self installDir.
- aPackage relativeDirectory isNil
-    ifFalse: [ baseDir := Directory append: aPackage relativeDirectory to: baseDir ].
- aPackage allFiles do: [ :file || destName |
-    destName := (Directory append: file to: baseDir).
-    (File name: destName) emitRemove ]
+ aPackage relativeDirectory isNil ifFalse: [
+    baseDir := baseDir directoryAt: aPackage relativeDirectory ].
+
+ aPackage allFiles do: [ :file |
+    (baseDir fileAt: file) emitRemove ]
     ]
 
     runOnStar: aPackage [ ]
@@ -465,7 +420,7 @@ PkgList subclass: PkgPackageList [
     runOnPackage: aPackage [ aPackage name displayNl ]
 ]
 
-| srcdir installDir mode listFiles destdir packageFiles helpString dryRun vpath |
+| srcdir installDir mode listFiles destdir packageFiles helpString vpath |
 
 mode := PkgInstall.
 listFiles := OrderedCollection new.
@@ -475,7 +430,6 @@ srcdir := nil.
 packageFiles := OrderedCollection new.
 packages := PackageFiles new.
 vpath := false.
-dryRun := false.
 allFiles := false.
 copy := false.
 
@@ -535,7 +489,7 @@ The default target directory is $install
             opt = 'list-files' ifTrue: [ mode := PkgList. listFiles add: arg ].
             opt = 'srcdir' ifTrue: [ srcdir := arg ].
             opt = 'destdir' ifTrue: [ destdir := arg ].
-            opt = 'dry-run' ifTrue: [ dryRun := true ].
+            opt = 'dry-run' ifTrue: [ Command dryRun: true ].
             opt = 'all-files' ifTrue: [ allFiles := true ].
             opt = 'copy' ifTrue: [ copy := true ].
             opt = 'vpath' ifTrue: [ vpath := true ].
@@ -550,7 +504,6 @@ The default target directory is $install
         destDir: destdir installDir: installDir;
  srcdir: srcdir;
  addAllFiles: packageFiles;
- dryRun: dryRun;
  allFiles: allFiles;
  copy: copy;
  prolog;

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk