"

 COPYRIGHT (c) 2012-2013 by Jan Vrany

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libscm/mercurial' }"

StandaloneStartup subclass:#HGInstaller

	instanceVariableNames:'version destination archive'

	classVariableNames:'DownloadURL RunningStandalone SeverityError SeverityWarning

		SeverityInfo'

	poolDictionaries:''

	category:'SCM-Mercurial-StX-Installer'

!

!HGInstaller class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2012-2013 by Jan Vrany

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    A simple standalone installer for Mercurial support. It downloads

    and installs Mercurial support into Smalltalk/X IDE.

    Usage (command line):

        # install latest stable version

        stx --execute HGInstaller.st 

        # install latest development version                             

        stx --execute HGInstaller.st --version default

        # install Mercurial for manually downloaded archive

        stx --execute HGInstaller.st --archive downloaded-archive.zip

    Usage (workspace)

        # install latest stable version

        HGInstaller install

        # install latest development version                             

        HGInstaller install: #default

   [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!HGInstaller class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    SeverityError := #error.

    SeverityWarning := #warning.

    SeverityInfo := #info.

    DownloadURL := 'https://bitbucket.org/janvrany/stx-libscm/get' asURI.

    (RunningStandalone := Smalltalk commandName endsWith: (self name , '.st')) ifTrue:[

        self start 

    ]

    "Modified: / 07-07-2013 / 23:31:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!HGInstaller class methodsFor:'defaults'!

allowDebugOption

    "enable/disable the --debug startup option.

     Can be redefined in subclasses to enable it"

    ^ true

    "Created: / 07-07-2013 / 18:46:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

allowScriptingOption

    "enable/disable the --scripting startup option.

     Can be redefined in subclasses to enable it"

    ^ true

    "Created: / 07-07-2013 / 18:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

suppressRCFileReading

    "enable/disable the rc-file reading (and also the --rcFileName option).

     If suppressed, there is no chance to interfere with the startup.

     Can be redefined in subclasses to disable it"

    ^ true

    "Created: / 07-07-2013 / 18:46:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller class methodsFor:'helpers'!

printInfo:msg

    Transcript 

        show:'[INFO]: ';

        showCR:msg

    "Created: / 07-07-2013 / 18:48:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller class methodsFor:'installer API'!

install

    "Installs latest 'default' version of Mercurial support"

    ^self new install

    "Created: / 07-07-2013 / 10:56:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

install: rev

    "Installs given revision of Mercurial support"

    ^self new install: rev

    "Created: / 07-07-2013 / 10:56:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller class methodsFor:'startup'!

main:argv

    "superclass StandaloneStartup class says that I am responsible to implement this method"

    ^self new main: argv

    "Modified: / 07-07-2013 / 18:26:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 07-07-2013 / 22:00:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller class methodsFor:'startup-private'!

applicationRegistryPath

    "the key under which this application stores its process ID in the registry

     as a collection of path-components.

     i.e. if #('foo' 'bar' 'baz') is returned here, the current applications ID will be stored

     in HKEY_CURRENT_USER\Software\foo\bar\baz\CurrentID.

     (would also be used as a relative path for a temporary lock file under unix).

     Used to detect if another instance of this application is already running."

    ^ #(libscm mercurial installer)

    "Modified: / 07-07-2013 / 18:24:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

applicationUUID

    "answer an application-specific unique uuid.

     This is used as the name of some exclusive OS-resource, which is used to find out,

     if another instance of this application is already running.

     Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used.

     If redefined, please return a real UUID (i.e. UUID fromString:'.....') and not a string or

     similar possibly conflicting identifier.

     You can paste a fresh worldwide unique id via the editor's more-misc-paste UUID menuFunction."

    ^ UUID fromString:'132746c0-e72a-11e2-85f0-606720e43e2c'

    "Modified: / 07-07-2013 / 18:24:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller methodsFor:'initialization'!

initialize

    "Invoked when a new instance is created."

    "/ please change as required (and remove this comment)

    version := 'default'.

    "/ super initialize.   -- commented since inherited method does nothing

    "Modified: / 07-07-2013 / 11:11:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller methodsFor:'installation'!

install

    self doPrepare.

    self doDownload.

    self doExtract.

    self doCompile.

    self doConfigure.

    "Created: / 07-07-2013 / 11:07:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-07-2013 / 19:06:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

install: ver

    version := ver.

    self install.

    "Created: / 07-07-2013 / 11:08:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller methodsFor:'installation-private'!

doCompile

    | cmd |

    cmd := OperatingSystem isMSWINDOWSlike ifTrue:[ 'bmake.bat'] ifFalse:['make'].

    ( destination directory / 'stc' ) exists ifTrue:[

        | log |

        log := Filename newTemporaryIn: Filename tempDirectory nameTemplate:'compile-%1-%2.log'.            

        log writingFileDo:[:logs|

            Transcript nextPutLine: 'Compiling...'.

            (OperatingSystem executeCommand: cmd outputTo: logs errorTo: logs inDirectory: destination pathName) ifFalse:[

                self log: 

                        'Compilation failed' 

                     details:

                        'This is not fatal, but the package will be loaded from source

                         instead of from binary class library, which is slower. 

                         You may want to check the compilation log in:

                         ', log pathName

                    severity: SeverityWarning.       

             ].

        ]

    ].

    "Created: / 07-07-2013 / 18:50:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-07-2013 / 23:34:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

doConfigure

    | top rcd |

    Transcript nextPutAll: 'Configuring...'.

    top := (Smalltalk getPackageDirectoryForPackage: Object package) directory directory.

    rcd := top / 'stx'/ 'projects' / 'smalltalk' / 'rc.d'.

    rcd isDirectory ifTrue:[

        (rcd / '50_mercurial.rc') writingFileDo:[:s|

            s nextPutLine:'"/ Load Mercurial support'.

            top = destination directory directory ifFalse:[

                s nextPutLine: ('Smalltalk packagePath: (Smalltalk packagePath: %1).' bindWith: destination directory directory pathName).        

            ].

            s nextPutAll:'Smalltalk loadPackage: ''stx:libscm/mercurial''.'.    

        ].            

    ] ifFalse:[

    ]

    "Created: / 07-07-2013 / 11:19:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 08-07-2013 / 00:28:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

doDownload

    | url  cmd |

    archive notNil ifTrue:[ ^ self ].

    archive := Filename newTemporary.

    url := DownloadURL / (version , '.zip').

    Transcript nextPutAll:'Downloading from ';nextPutAll: url asString; nextPutLine:  '...'.

"/    url scheme = 'https' ifTrue:[

    (OperatingSystem canExecuteCommand:'curl') ifTrue:[

        cmd := 'curl -s -o %1 %2' bindWith:archive pathName with:url.

    ] ifFalse:[

        (OperatingSystem canExecuteCommand:'wget') ifTrue:[

            cmd := 'wget -s -o %1 %2' bindWith:archive pathName with:url.

        ] ifFalse:[

            self 

                error:'Either ''curl'' nor  ''wget'' found, please install one of them'

        ].

    ].

    (OperatingSystem executeCommand:cmd) ifFalse:[

        self error:'Could not download file, command used: ''' , cmd , ''''.

    ].

    (ZipArchive isZipArchive: archive) ifFalse:[

        self error: ('Downloaded file (%1) is not a .zip archive!!' bindWith: archive pathName).

    ].  

    "/    ]

    "Created: / 07-07-2013 / 11:19:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-07-2013 / 20:52:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

doExtract

    | zar |

    Transcript nextPutLine:'Extracting...'.

    [

        destination recursiveMakeDirectory.

    ] on:Error

            do:[:ex | 

        self 

            error:'Cannot make destination directory ' , destination pathName , ': ' 

                    , ex description

    ].

    zar := ZipArchive oldFileNamed:archive pathName.

    zar members do:[:zmemb | 

        | i  src  dst  dstd skipIt |

        src := zmemb fileName.

        i := src indexOf:$/.

        i ~~ 0 ifTrue:[

            src := src copyFrom:i + 1.

        ].

        skipIt := (src startsWith:'git') 

                        or:[src startsWith: 'mercurial/docs'].

        skipIt ifFalse:[

           dst := OperatingSystem isMSWINDOWSlike 

                   ifTrue:[destination / (src copyReplaceAll:$/ with:Filename separator)]

                   ifFalse:[destination / src].

           (dstd := dst directory) exists ifFalse:[

               dstd recursiveMakeDirectory

           ].

           dst writingFileDo:[:f | 

               Transcript nextPutAll: '  '; nextPutLine: src.

               zar extract:zmemb fileName intoStream:f 

           ].

        ].

    ].

    "Created: / 07-07-2013 / 11:19:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-07-2013 / 19:22:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 07-07-2013 / 20:51:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

doPrepare

    | pp |

    pp := Smalltalk getPackageDirectoryForPackage:'stx:libscm'.

    pp isNil ifTrue:[

        pp := Smalltalk getPackageDirectoryForPackage:'stx:libbasic'.

    ].

    destination := pp directory isWritable 

                    ifTrue:[pp directory / 'libscm']

                    ifFalse:[Filename homeDirectory / '.stx' / 'packages' / 'stx' / 'libscm'].

    Transcript nextPutLine: 'Installing version ', version , ' to ', destination pathName.

    "Created: / 07-07-2013 / 19:06:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller methodsFor:'logging'!

log:message details: details severity:severity 

    | stream |

    (severity == SeverityInfo and:[Verbose not]) ifTrue:[ ^ self ].

    stream := RunningStandalone ifTrue:[Stderr] ifFalse:[Transcript].

    stream

        nextPut:$[;

        nextPutAll:severity asUppercase;

        nextPutAll:']: ';

        nextPutLine:message.

    details notNil ifTrue:[

        details asStringCollection do:[:line | 

            stream

                nextPutAll:'  ';

                nextPutLine:line trimSeparators.

        ]

    ].

    severity == SeverityError ifTrue:[

        RunningStandalone ifTrue:[

            Smalltalk exit:1.

        ] ifFalse:[

            self error:message

        ]

    ].

    "Created: / 07-07-2013 / 23:23:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 08-07-2013 / 00:27:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log:message severity:severity 

    self log:message details: nil severity:severity

    "Created: / 07-07-2013 / 23:34:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGInstaller methodsFor:'running'!

main: argv

    "Run the installer. This is called when the installer

     is called from a command line as:

        stx --execute HGInstaller.st

    "

    | i |

    (Smalltalk getPackageDirectoryForPackage: Object package) isNil ifTrue:[

        | cmd root |

        cmd := OperatingSystem pathOfSTXExecutable asFilename asAbsoluteFilename.

        root := cmd directory directory directory directory.

        root infoPrintCR.

        (root / 'stx' / 'libbasic') isDirectory ifFalse:[

            self error: 'Cannot determine package path'.

        ].

        Smalltalk packagePath: (Smalltalk packagePath copyWith: root pathName).

    ].

    i := 1.

    [ i <= argv size ] whileTrue:[

        | a |

        a := argv at: i.

        a = '--version' ifTrue:[

            i = argv size ifTrue:[

                self error: '--version requires an argument!!'

            ].

            version := argv at: i + 1.

            i := i + 2.            

        ].

        a = '--archive' ifTrue:[

            i = argv size ifTrue:[

                self error: '--archive requires an argument!!'

            ].

            archive := (argv at: i + 1) asFilename.

            archive exists ifFalse:[

                self error: ('File %1 does not exist' bindWith: archive pathName).

            ].

            archive isReadable ifFalse:[

                self error: ('File %1 does is not readable!!' bindWith: archive pathName).

            ].

            (ZipArchive isZipArchive: archive) ifFalse:[

                self error: ('File %1 is not a .zip archive!!' bindWith: archive pathName).

            ].

            i := i + 2.            

        ].        

    ].

    [

        self install.

    ] on: Error do:[:ex|

        self log: 'Unexpected error: ', ex description severity: SeverityError

    ]

    "Created: / 07-07-2013 / 18:30:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-07-2013 / 23:35:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

HGInstaller initialize!