[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] Don't emit sh commands in gst-package.in
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] [PATCH] Don't emit sh commands in gst-package.in |
Date: |
Wed, 04 Jul 2007 11:28:28 +0200 |
User-agent: |
Thunderbird 2.0.0.4 (Macintosh/20070604) |
Just execute them using File/Directory and the newly introduced bindings
to mkdtemp and chmod. Only zip is executed using #system:.
Paolo
* looking for address@hidden/smalltalk--devo--2.2--patch-442 to compare with
* auto-adding address@hidden/smalltalk--devo--2.2--patch-442 to greedy revision
library /Users/bonzinip/Archives/revlib
* found immediate ancestor revision in library
(address@hidden/smalltalk--devo--2.2--patch-441)
* patching for this revision (address@hidden/smalltalk--devo--2.2--patch-442)
* comparing to address@hidden/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;
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] Don't emit sh commands in gst-package.in,
Paolo Bonzini <=