packages/StxPackageFileWriter.st
author james
Wed, 09 Apr 2003 13:38:42 +0200
changeset 1231 2f3a15bfac92
child 1238 b59fc0746f8c
permissions -rw-r--r--
initial checkin

"{ Package: 'stx:libbasic3' }"

"{ NameSpace: Packages }"

Object subclass:#StxPackageFileWriter
	instanceVariableNames:'handler stream'
	classVariableNames:''
	poolDictionaries:''
	category:'Package-Handlers'
!

Object subclass:#Version1
	instanceVariableNames:'package'
	classVariableNames:''
	poolDictionaries:''
	privateIn:StxPackageFileWriter
!


!StxPackageFileWriter class methodsFor:'instance creation'!

forPackage:aPackage 

    ^ (self version:1) forPackage:aPackage 
!

version:aVersionNumber

    aVersionNumber == 1 ifTrue:[
        ^ Version1.
    ].
    self error:'Version unknown'
! !

!StxPackageFileWriter::Version1 class methodsFor:'instance creation'!

forPackage:aPackage
    ^ self basicNew package:aPackage
! !

!StxPackageFileWriter::Version1 methodsFor:'accessing'!

fileOutVersion
    ^ 1
!

package
    "return the value of the instance variable 'package' (automatically generated)"

    ^ package
!

package:something
    "set the value of the instance variable 'package' (automatically generated)"

    package := something.
! !

!StxPackageFileWriter::Version1 methodsFor:'api'!

savePackageAs:aFilename
    | writeStream |
    self createPathFor:aFilename.
    [ 
        self canWriteTo:aFilename. "may return exceptions"
        writeStream := aFilename writeStream.
        self savePackageOn:writeStream.   "may return exceptions"
    ] ensure:[
        writeStream close.
    ].

    package markClean.
    ^ package
!

savePackageOn:aWriteStream
    self forPackage:package saveInstallationScriptChunkOn:aWriteStream.
    self forPackage:package saveClassDefinitionsOn:aWriteStream.
    self forPackage:package saveLooseMethodsOn:aWriteStream.
! !

!StxPackageFileWriter::Version1 methodsFor:'fileOut - chunks'!

forPackage:aPackage saveClassDefinitionsOn:aWriteStream 

    aPackage classNames size > 0 ifTrue:[
        aWriteStream nextPutAll:'"Class Definitions"!!'.
        aWriteStream cr.
        aPackage classNames do:[:aClass |
            self fileOutClass:(Smalltalk at:aClass) on:aWriteStream.
        ].
        aWriteStream cr.
        aWriteStream nextPutAll:'"End of Class Definitions"!!'.
        aWriteStream cr.
    ].
!

forPackage:aPackage saveInstallationScriptChunkOn:aWriteStream
    "create an installation script which is used to create
     an initial package which can help determine if the package
     is loadable"
    self forPackage:aPackage savePackageFormatOn:aWriteStream.
    self forPackage:aPackage savePackageInstanceCreationOn:aWriteStream.
    self forPackage:aPackage savePackageFileVersionOn:aWriteStream.
    self forPackage:aPackage savePackageCommentOn:aWriteStream.
    self forPackage:aPackage saveClassNamesOn:aWriteStream.
    self forPackage:aPackage saveLooseMethodNamesOn:aWriteStream.
    self forPackage:aPackage saveScriptsOn:aWriteStream.
    self forPackage:aPackage savePrerequisitesOn:aWriteStream.
    self forPackage:aPackage saveEndingOn:aWriteStream.
!

forPackage:aPackage saveLooseMethodsOn:aWriteStream 
    aPackage looseMethods size > 0 ifTrue:[
        aWriteStream nextPutAll:'"LooseMethods"!!'.
        aWriteStream cr.
        aPackage looseMethods do:[:aLooseMethod |
            self fileOutLooseMethod:aLooseMethod on:aWriteStream
        ].
        aWriteStream nextPutAll:'!!'.
        aWriteStream cr.

        aWriteStream nextPutAll:'"End of LooseMethods"!!'.
    ].
! !

!StxPackageFileWriter::Version1 methodsFor:'fileOut - subparts'!

fileOutClass:aClass on:aWriteStream

    "ClassDescription fileOutErrorSignal can occur here from autoloaded classes"
    aClass isLoaded ifFalse:[
        aClass autoload
    ].

    package blockedMethods isEmpty ifFalse:[
        Transcript 
                nextPutAll:'Finnish me!!'; 
                cr;
                nextPutAll:'''blockedMethods '' are not accounted for at the moment!!'' in:'; 
                cr;
                nextPutAll:'Packages::StxPackageFileWriter::Version1>>fileOutClass:on:'  ; 
                cr
        
    ].
    aClass fileOutOn:aWriteStream
!

fileOutLooseMethod:aMethod on:aWriteStream 

    aWriteStream nextPut:$!!.
    aWriteStream nextPutAll:aMethod mclass asString.
    aWriteStream nextPutAll:' methodsFor:'.
    aWriteStream nextPut:$'.
    aWriteStream nextPutAll:(aMethod category).
    aWriteStream nextPut:$'.
    aWriteStream nextPut:$!!.
    aWriteStream cr.

    aWriteStream nextPutAll:aMethod source.
    aWriteStream nextPut:$!!.
    aWriteStream cr.
!

forPackage:aPackage saveClassNamesOn:aWriteStream

    aPackage classNames size > 0 ifTrue:[

        aWriteStream 
            nextPutAll:'"ClassNames"';
            cr.

        aWriteStream 
            nextPutAll:'aPackage ';
            cr.

        aPackage classNames do:[:aClassname |
            aWriteStream 
                nextPutAll:'    addClassNamed:#', aClassname, ';';
                cr.
        ].

        aWriteStream nextPutAll:'    yourself.'; "pointless but makes this code more readable"    
        cr.

        aWriteStream 
            nextPutAll:'"End of ClassNames"';
            cr;
            cr.

    ].
!

forPackage:aPackage saveEndingOn:aWriteStream
    aWriteStream 
        nextPutAll:'aPackage!!';
        cr;
        cr.
!

forPackage:aPackage saveLooseMethodNamesOn:aWriteStream

    aPackage looseMethods size > 0 ifTrue:[

        aWriteStream 
            nextPutAll:'"LooseMethodNames"';
            cr.

        aWriteStream 
            nextPutAll:'aPackage ';
            cr.

        aPackage looseMethods do:[:aMethod |
            aWriteStream 
                nextPutAll:'    addMethodNamed:#', aMethod name, ' forClassNamed:#', aMethod mclass name,';';
                cr.
        ].

        aWriteStream nextPutAll:'    yourself.'. "pointless but makes this code more readable"    
        aWriteStream 
            cr;
            nextPutAll:'"End of LooseMethodNames"';
            cr;
            cr.
    ].
!

forPackage:aPackage savePackageCommentOn:aWriteStream 
    aWriteStream
        nextPutAll:'aPackage packageComment:';
        nextPutAll:aPackage packageComment ? '''''';
        nextPut:$.;
        cr;
        cr.
!

forPackage:aPackage savePackageFileVersionOn:aWriteStream 

    aWriteStream 
        nextPutAll:'aPackage packageVersion:';
        nextPutAll:self fileOutVersion printString;
        nextPut:$.;
        cr.
!

forPackage:aPackage savePackageFormatOn:aWriteStream 
    aWriteStream nextPutAll:'!!Packages::PackageHandler openStxPackageFormat:1!!';
    cr
!

forPackage:aPackage savePackageInstanceCreationOn:aWriteStream 
    aWriteStream 
        nextPutAll:'|aPackage|';
        cr;
        nextPutAll:'aPackage := Package named: ';
        nextPut:$';
        nextPutAll:aPackage name;
        nextPut:$';
        nextPut:$.;
        cr.
!

forPackage:aPackage savePrerequisitesOn:aWriteStream

    aPackage prerequisites size > 0 ifTrue:[
        aWriteStream
            nextPutAll:'"Prerequisites"';
            cr.

        self forPackage:aPackage savePrerequisteClassesOn:aWriteStream.
        self forPackage:aPackage  savePrerequistePackagesOn:aWriteStream.
        aWriteStream
            nextPutAll:'"End of Prerequisites"';
            cr;
            cr.
        
    ]

!

forPackage:aPackage savePrerequisteClassesOn:aWriteStream

    aPackage classPrerequisites size > 0 ifTrue:[

        aPackage classPrerequisites do:[:prerequisite |

            aWriteStream
                nextPutAll:'aPackage' ;
                cr;
                nextPutAll:'   addClassNamePrerequisite:#', prerequisite name;
                cr;
                nextPutAll:'   ifFailString:';
                nextPut:$';
                nextPutAll:prerequisite ifFailedString;
                nextPut:$';
                nextPut:$;;
                cr.
        ].

        aWriteStream nextPutAll:'   yourself.'; "pointless but makes this code more readable"    
        cr.


    ].
!

forPackage:aPackage savePrerequistePackagesOn:aWriteStream

    aPackage packagePrerequisites size > 0 ifTrue:[

        aPackage packagePrerequisites do:[:prerequisite |

            aWriteStream
                nextPutAll:'aPackage' ;
                cr;
                nextPutAll:'   addPackageNamePrerequisite:#', prerequisite name;
                cr;
                nextPutAll:'   ifFailString:';
                nextPut:$';
                nextPutAll:prerequisite ifFailedString;
                nextPut:$';
                nextPut:$;;
                cr.
        ].

        aWriteStream nextPutAll:'   yourself.'; "pointless but makes this code more readable"    
        cr.
    ]
!

forPackage:aPackage saveScriptsOn:aWriteStream 

    aPackage scripts size > 0 ifTrue:[ | aScript |

        aWriteStream 
            nextPutAll:'"Scripts"';
            cr.
        (aScript := aPackage postInstallScript) getString size == 0 ifFalse:[
            aWriteStream
                nextPutAll:'aPackage postInstallScriptString:';
                nextPut:$';
                nextPutAll:aScript getString;
                nextPut:$';
                nextPut:$.;
                cr.
        ].

        (aScript := aPackage preInstallScript) getString size == 0 ifFalse:[
            aWriteStream
                nextPutAll:'aPackage preInstallScriptString:';
                nextPut:$';
                nextPutAll:aScript getString;
                nextPut:$';
                nextPut:$.;
                cr.
        ].

        (aScript := aPackage postUninstallScript) getString size == 0 ifFalse:[
            aWriteStream
                nextPutAll:'aPackage postUninstallScriptString:';
                nextPut:$';
                nextPutAll:aScript getString;
                nextPut:$';
                nextPut:$.;
                cr.
        ].

        (aScript := aPackage postUninstallScript) getString size == 0 ifFalse:[
            aWriteStream
                nextPutAll:'aPackage preUninstallScriptString:';
                nextPut:$';
                nextPutAll:aScript getString;
                nextPut:$';
                nextPut:$.;
                cr.
        ].
        aWriteStream
            cr;
            cr.


    ].
! !

!StxPackageFileWriter::Version1 methodsFor:'helpers'!

createPathFor:aFilename
    " create the path name for the filename if it does not already exist"
    ^ aFilename directory makeDirectory.
! !

!StxPackageFileWriter::Version1 methodsFor:'instance creation'!

forPackage:aPackage
    ^ self basicNew package:aPackage
! !

!StxPackageFileWriter::Version1 methodsFor:'queries'!

canWriteTo:aFilename
    "return an error if the reciever cannot write to aFilename"

    aFilename isFilename ifFalse:[
        ^ self error:aFilename printString, ' is not a filename so cannot be written to.'.
    ].

    aFilename directory exists ifFalse:[
        ^ self error:aFilename directory printString, ' directory does not exist.'.
    ].

    aFilename directory canBeWritten ifFalse:[
        ^ self error:aFilename printString, ' cannot be written to.'.
    ].

    (aFilename isDirectory not) ifFalse:[
        ^ self error:aFilename printString, ' is a directory and cannot be written to'.
    ].
! !

!StxPackageFileWriter class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic3/packages/StxPackageFileWriter.st,v 1.1 2003-04-09 11:34:02 james Exp $'
! !