'From Squeak3.1alpha of 28 February 2001 [latest update: #4174] on 27 June 2001 at 10:21:56 pm'! "Change Set: projectServer Date: 25 June 2001 Author: Michael Rueger, Andreas Raab Includes a fix to allow loading of read-only project files. Keeps the encoding of imported image files when uploading a project to the server. When publishing a project under a different name or to a different server all external resources are automatically uploaded. All references to external resources are now relative, so it is possible to move a project to a different server or directory. The 'publish' and 'publish as' logic has also been changed: on 'publish' only servers that allow uploads are presented. If the user hits 'publish' on a project from a read-only server, 'publish as' is automatically invoked. 'Publish as' now always includes the rename step and the server selection. Adds the ability to define servers and project directories in external pref files (see update extSettings). Using this mechanism the image itself doesn't need to include any predefined server at all. If the image already contains server definitions the external ones are added or override the image internal one. The currently defined servers can be stored via e.g. ServerDirectory storeCurrentServersIn: (FileDirectory default directoryNamed: 'currentServers') Each server is defined in its own file. The initialization process scans the /knownServers directory for files. The file format for servers is: name: Squeakland-Projects type: http (possible types: ftp, http, bss, file) server: www.squeakland.org directory: projects group: Squeak Public Updates user: squeak url: http://www.squeakland.org/projects (optional: the visible url, might be different from the server/directory combination) loaderUrl: http://www.squeakland.org/projects.jsp acceptsUploads: true (optional: if true, this server accepts uploads (see below)) The file format for local project directories is: name: projects directory: C:\projects type: file This update allows server definitions to be stored on an external file. Nothing will happen unless you take action to turn it on. Some users may not want to use this feature. Here is how to turn it on: ServerDirectory transferServerDefinitionsToExternal. "! Error subclass: #InvalidDirectoryError instanceVariableNames: 'pathName ' classVariableNames: '' poolDictionaries: '' category: 'System-Exceptions Kernel'! Object subclass: #ResourceCollector instanceVariableNames: 'stubMap originalMap locatorMap localDirectory baseUrl internalStubs resourceDirectory ' classVariableNames: 'Current ' poolDictionaries: '' category: 'System-Support'! Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject socket loaderUrl ' classVariableNames: 'LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-Kernel'! ServerDirectory subclass: #ProjectSwikiServer instanceVariableNames: 'acceptsUploads ' classVariableNames: '' poolDictionaries: '' category: 'Network-Kernel'! !EToyProjectDetailsMorph class methodsFor: 'as yet unclassified' stamp: 'mir 6/19/2001 10:17'! getFullInfoFor: aProject ifValid: aBlock expandedFormat: expandedFormat | me | (me _ self basicNew) expandedFormat: expandedFormat; project: aProject actionBlock: [ :x | aProject world setProperty: #ProjectDetails toValue: x. x at: 'projectname' ifPresent: [ :newName | aProject renameTo: newName. ]. me delete. aBlock value. ]; initialize; openCenteredInWorld! ! !EToyProjectDetailsMorph class methodsFor: 'as yet unclassified' stamp: 'mir 6/19/2001 10:17'! test1: aProject "EToyProjectDetailsMorph test1: Project current" (self basicNew) project: aProject actionBlock: [ :x | aProject world setProperty: #ProjectDetails toValue: x. x at: 'projectname' ifPresent: [ :newName | aProject renameTo: newName. ] ]; initialize; openCenteredInWorld! ! !FileDirectory methodsFor: 'testing' stamp: 'mir 6/25/2001 13:08'! acceptsUploads ^true! ! !FileDirectory methodsFor: 'testing' stamp: 'ar 5/30/2001 21:42'! isAFileNamed: fName ^FileStream isAFileNamed: (self fullNameFor: fName)! ! !FileDirectory methodsFor: 'private' stamp: 'ar 5/30/2001 20:49'! directoryContentsFor: fullPath "Return a collection of directory entries for the files and directories in the directory with the given path. See primLookupEntryIn:index: for further details." "FileDirectory default directoryContentsFor: ''" | entries index done entryArray | entries _ OrderedCollection new: 200. index _ 1. done _ false. [done] whileFalse: [ entryArray _ self primLookupEntryIn: fullPath index: index. #badDirectoryPath = entryArray ifTrue: [ ^(InvalidDirectoryError pathName: pathName) signal]. entryArray == nil ifTrue: [done _ true] ifFalse: [entries addLast: (DirectoryEntry fromArray: entryArray)]. index _ index + 1]. ^ entries asArray ! ! !FileDirectory methodsFor: 'private' stamp: 'mir 6/25/2001 18:05'! storeServerEntryOn: stream stream nextPutAll: 'name:'; tab; nextPutAll: self localName; cr; nextPutAll: 'directory:'; tab; nextPutAll: self pathName; cr; nextPutAll: 'type:'; tab; nextPutAll: 'file'; cr! ! !FileDirectory methodsFor: 'squeaklets' stamp: 'mir 6/17/2001 23:42'! downloadUrl ^''! ! !FileDirectory class methodsFor: 'name utilities' stamp: 'ar 5/30/2001 19:47'! urlForFileNamed: aFilename "Create a URL for the given fully qualified file name" "FileDirectory urlForFileNamed: 'C:\Home\andreasr\Squeak\DSqueak3\DSqueak3_1.1\DSqueak3.1.image'" | path localName | self splitName: aFilename to:[:p :n| path _ p. localName _ n]. ^localName asUrlRelativeTo: (self on: path) url asUrl! ! !FileList methodsFor: 'file list menu' stamp: 'ar 5/30/2001 19:48'! openImageInWindow "Handle five file formats: GIF, JPG, PNG, Form stoteOn: (run coded), and BMP. Fail if file format is not recognized." | image myStream | myStream _ (directory readOnlyFileNamed: fileName) binary. image _ Form fromBinaryStream: myStream. myStream close. Smalltalk isMorphic ifTrue:[ Project current resourceManager addResource: image url: (fileName asUrlRelativeTo: directory url asUrl) asString. ]. Smalltalk isMorphic ifTrue: [(SketchMorph withForm: image) openInWorld] ifFalse: [FormView open: image named: fileName]! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'mir 5/24/2001 18:00'! limitedSuperSwikiDirectoryList | dir nameToShow dirList | dirList _ OrderedCollection new. ServerDirectory serverNames do: [ :n | dir _ ServerDirectory serverNamed: n. dir isProjectSwiki ifTrue: [ nameToShow _ n. dirList add: ((dir directoryWrapperClass with: dir name: nameToShow model: self) balloonText: dir realUrl) ]. ]. (ServerDirectory localProjectDirectories copyWith: Project squeakletDirectory) do: [ :each | dirList add: (FileDirectoryWrapper with: each name: each localName model: self) ]. ^dirList! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'mir 6/25/2001 13:08'! limitedSuperSwikiPublishDirectoryList | dir nameToShow dirList | dirList _ OrderedCollection new. ServerDirectory serverNames do: [ :n | dir _ ServerDirectory serverNamed: n. dir isProjectSwiki ifTrue: [ nameToShow _ n. dirList add: ((dir directoryWrapperClass with: dir name: nameToShow model: self) balloonText: dir realUrl) ]. ]. ServerDirectory localProjectDirectories do: [ :each | dirList add: (FileDirectoryWrapper with: each name: each localName model: self) ]. ^dirList select: [:each | each withoutListWrapper acceptsUploads]! ! !FileUrl methodsFor: 'downloading' stamp: 'ar 5/30/2001 20:59'! retrieveContents | file pathString s type entries | pathString _ self pathForFile. file _ [FileStream readOnlyFileNamed: pathString] on: FileDoesNotExistException do:[:ex| ex return: nil]. file ifNotNil: [ type _ file mimeTypes. type ifNotNil:[type _ type first]. type ifNil:[MIMEDocument guessTypeFromName: self path last]. ^MIMELocalFileDocument contentType: type contentStream: file]. "see if it's a directory..." entries _ [(FileDirectory on: pathString) entries] on: InvalidDirectoryError do:[:ex| ex return: nil]. entries ifNil:[^nil]. s _ WriteStream on: String new. (pathString endsWith: '/') ifFalse: [ pathString _ pathString, '/' ]. s nextPutAll: 'Directory Listing for ', pathString, ''. s nextPutAll: '

Directory Listing for ', pathString, '

'. s nextPutAll: ''. ^MIMEDocument contentType: 'text/html' content: s contents url: ('file:', pathString)! ! !Form class methodsFor: 'instance creation' stamp: 'ar 5/30/2001 19:50'! fromFileNamed: fileName "Read a Form or ColorForm from the given file." | file form | file _ (FileStream readOnlyFileNamed: fileName) binary. form _ self fromBinaryStream: file. Smalltalk isMorphic ifTrue:[ Project current resourceManager addResource: form url: (FileDirectory urlForFileNamed: file name)]. file close. ^ form ! ! !HTTPClient class methodsFor: 'utilities' stamp: 'mir 6/15/2001 18:39'! getDirectoryListing: dirListURL "HTTPClient getDirectoryListing: 'http://www.squeakalpha.org/uploads' " | answer ftpEntries | " answer _ self httpPostDocument: dirListURL args: Dictionary new." "Workaround for Mac IE problem" answer _ self httpGetDocument: dirListURL. answer isString ifTrue: [^self error: 'Listing failed: ' , answer] ifFalse: [answer _ answer content]. answer first == $< ifTrue: [self error: 'Listing failed: ' , answer]. ftpEntries _ answer findTokens: SimpleClientSocket crLf. ^ ftpEntries collect:[:ftpEntry | ServerDirectory parseFTPEntry: ftpEntry] thenSelect: [:entry | entry notNil]! ! !HTTPRequest methodsFor: 'accessing' stamp: 'ar 5/30/2001 21:03'! contentStream "Return a stream on the content of a previously completed HTTP request" semaphore wait. ^content ifNotNil:[content contentStream]! ! !InvalidDirectoryError methodsFor: 'accessing' stamp: 'ar 5/30/2001 20:44'! pathName ^pathName! ! !InvalidDirectoryError methodsFor: 'accessing' stamp: 'ar 5/30/2001 20:45'! pathName: badPathName pathName _ badPathName! ! !InvalidDirectoryError methodsFor: 'exceptionDescription' stamp: 'ar 5/30/2001 20:49'! defaultAction "Return an empty list as the default action of signaling the occurance of an invalid directory." ^#()! ! !InvalidDirectoryError class methodsFor: 'exceptionInstantiator' stamp: 'ar 5/30/2001 20:49'! pathName: badPathName ^self new pathName: badPathName! ! !PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'ar 5/30/2001 19:49'! dropFiles: anEvent "Handle a number of dropped files from the OS. TODO: - use a more general mechanism for figuring out what to do with the file (perhaps even offering a choice from a menu) - remember the resource location or (when in browser) even the actual file handle " | numFiles stream sketch type image | numFiles _ anEvent contents. 1 to: numFiles do:[:i| stream _ FileStream requestDropStream: i. type _ stream mimeTypes. type ifNotNil:[type _ type first]. "for now just use the first one" "only image files will be handled for now" (type notNil and:[type beginsWith: 'image/']) ifTrue:[ stream binary. image _ Form fromBinaryStream: stream. Project current resourceManager addResource: image url: (FileDirectory urlForFileNamed: stream name) asString. sketch _ SketchMorph withForm: image. self addMorph: sketch centeredNear: anEvent position. ] ifFalse:[ "just get us a text editor" stream edit. ]. ].! ! !Project methodsFor: 'accessing' stamp: 'mir 6/22/2001 20:06'! forgetExistingURL self resourceManager makeAllProjectResourcesLocalTo: self resourceUrl. urlList _ nil! ! !Project methodsFor: 'accessing' stamp: 'mir 6/7/2001 16:18'! lastDirectory: aDirectoryOrNil lastDirectory _ aDirectoryOrNil! ! !Project methodsFor: 'accessing' stamp: 'mir 6/22/2001 14:20'! renameTo: newName newName = self name ifFalse: [ self resourceManager adjustToRename: newName from: self name. self changeSet name: newName. version _ nil].! ! !Project methodsFor: 'accessing' stamp: 'mir 6/26/2001 17:09'! storeNewPrimaryURL: aURLString | oldResourceUrl | oldResourceUrl _ self resourceUrl. urlList isEmptyOrNil ifTrue: [urlList _ Array new: 1]. urlList at: 1 put: aURLString. self lastDirectory: nil. self resourceManager adjustToNewServer: self resourceUrl from: oldResourceUrl ! ! !Project methodsFor: 'file in/out' stamp: 'ar 5/30/2001 23:34'! compressFilesIn: tempDir to: localName in: localDirectory resources: collector "Compress all the files in tempDir making up a zip file in localDirectory named localName" | archive entry urlMap archiveName | urlMap _ Dictionary new. collector locatorsDo:[:loc| "map local file names to urls" urlMap at: (tempDir localNameFor: loc localFileName) put: loc urlString. ResourceManager cacheResource: loc urlString inArchive: localName]. archive _ ZipArchive new. tempDir fileNames do:[:fn| archiveName _ urlMap at: fn ifAbsent:[fn]. entry _ archive addFile: (tempDir fullNameFor: fn) as: archiveName. entry desiredCompressionMethod: ZipArchive compressionStored. ]. archive writeToFileNamed: (localDirectory fullNameFor: localName). archive close. tempDir fileNames do:[:fn| tempDir deleteFileNamed: fn ifAbsent:[]]. localDirectory deleteDirectory: tempDir localName.! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/25/2001 10:50'! downloadUrl "^(self primaryServerIfNil: [^'']) downloadUrl" ^lastDirectory ifNil: [(self primaryServerIfNil: [^'']) downloadUrl] ifNotNil: [lastDirectory downloadUrl]! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/21/2001 15:05'! exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it .extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder collector fd mgr | "An experimental version to fileout a changeSet first so that a project can contain its own classes" world isMorph ifFalse: [ self projectParameters at: #isMVC put: true. ^ false]. "Only Morphic projects for now" world ifNil: [^ false]. world presenter ifNil: [^ false]. Utilities emptyScrapsBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState; releaseViewers. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [ self error: 'Still holding onto Global flaps']. world releaseSqueakPages. ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]). holder _ Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg _ self projectParameters at: #revertToMe ifAbsent: [nil]. self projectParameters removeKey: #revertToMe ifAbsent: []. roots _ OrderedCollection new. roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. roots add: world activeHand. "; addAll: classList; addAll: (classList collect: [:cls | cls class])" roots _ roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" fd _ aDirectory directoryNamed: self resourceDirectoryName. fd assureExistance. "Clean up resource references before writing out" mgr _ self resourceManager. self resourceManager: nil. ResourceCollector current: ResourceCollector new. ResourceCollector current localDirectory: fd. ResourceCollector current baseUrl: self resourceUrl. " ResourceCollector current baseUrl: self resourceDirectoryName." ResourceCollector current initializeFrom: mgr. ProgressNotification signal: '2:findingResources' extra: '(collecting resources...)'. "Must activate old world because this is run at #armsLength. Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent will not be captured correctly if referenced from blocks or user code." world becomeActiveDuring:[ is _ ImageSegment new copySmartRootsExport: roots asArray. "old way was (is _ ImageSegment new copyFromRootsForExport: roots asArray)" ]. self resourceManager: mgr. collector _ ResourceCollector current. ResourceCollector current: nil. ProgressNotification signal: '2:foundResources' extra: ''. is state = #tooBig ifTrue: [ collector replaceAll. ^ false]. str _ ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [ str _ str, '\Project''s own world is not in the segment.' withCRs]. str isEmpty ifFalse: [ ans _ (PopUpMenu labels: 'Do not write file Write file anyway Debug') startUpWithCaption: str. ans = 1 ifTrue: [ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [ collector replaceAll. self halt: 'Segment not written']]. is writeForExportWithSources: aFileName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: aFileName directory: fd. "Compress all files and update check sums" collector forgetObsolete. self storeResourceList: collector in: fd. self storeHtmlPageIn: fd. self compressFilesIn: fd to: aFileName in: aDirectory resources: collector. "Now update everything that we know about" mgr updateResourcesFrom: collector. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. holder. collector replaceAll. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. is arrayOfRoots do: [:obj | obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. ^ true ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/7/2001 14:41'! fromMyServerLoad: otherProjectName | pair pr dirToUse | "If a newer version of me is on the server, load it." (pr _ Project named: otherProjectName) ifNotNil: ["it appeared" ^ pr enter ]. dirToUse _ self primaryServerIfNil: [ lastDirectory ifNil: [ self inform: 'Current project does not know a server either.'. ^nil]. lastDirectory]. pair _ self class mostRecent: otherProjectName onServer: dirToUse. pair first ifNil: [^self decideAboutCreatingBlank: otherProjectName]. "nothing to load" ^ProjectLoading installRemoteNamed: pair first from: dirToUse named: otherProjectName in: self ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/7/2001 14:44'! loadFromServer: newerAutomatically "If a newer version of me is on the server, load it." | pair resp server | self assureIntegerVersion. self isCurrentProject ifTrue: ["exit, then do the command" ^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' ]. server _ self tryToFindAServerWithMe ifNil: [^ nil]. pair _ self class mostRecent: self name onServer: server. pair first ifNil: [^ self inform: 'can''t find file on server for ', self name]. self currentVersionNumber > pair second ifTrue: [ ^ self inform: 'That server has an older version of the project.']. version = (Project parseProjectFileName: pair first) second ifTrue: [ resp _ (PopUpMenu labels: 'Reload anyway\Cancel' withCRs) startUpWithCaption: 'The only changes are the ones you made here.'. resp ~= 1 ifTrue: [^ nil] ] ifFalse: [ newerAutomatically ifFalse: [ resp _ (PopUpMenu labels: 'Load it\Cancel' withCRs) startUpWithCaption: 'A newer version exists on the server.'. resp ~= 1 ifTrue: [^ nil] ]. ]. "let's avoid renaming the loaded change set since it will be replacing ours" self projectParameters at: #loadingNewerVersion put: true. ComplexProgressIndicator new targetMorph: nil; historyCategory: 'project loading'; withProgressDo: [ ProjectLoading installRemoteNamed: pair first from: server named: self name in: parentProject ] ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/7/2001 14:39'! primaryServer "Return my primary server, that is the one I was downloaded from or are about to be stored on." ^self primaryServerIfNil: [nil]! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/7/2001 14:39'! primaryServerIfNil: aBlock "Return my primary server, that is the one I was downloaded from or are about to be stored on. If none is set execute the exception block" | serverList | serverList _ self serverList. ^serverList isEmptyOrNil ifTrue: [aBlock value] ifFalse: [serverList first]! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/22/2001 14:07'! storeLocallyInnards "Save the project to the local disk only" | resp newName localDirectory localVersionPair myVersionNumber warning maxNumber oldVersion | self assureIntegerVersion. "Find out what version" localDirectory _ FileDirectory default. localVersionPair _ self class mostRecent: self name onServer: localDirectory. maxNumber _ myVersionNumber _ self currentVersionNumber. ProgressNotification signal: '2:versionsDetected'. warning _ ''. myVersionNumber < localVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) in the local directory'. maxNumber _ maxNumber max: localVersionPair second. ]. "8 Nov 2000 - only check on the first attempt to publish" myVersionNumber = 0 ifTrue: [ warning isEmpty ifFalse: [ myVersionNumber = 0 ifTrue: [ warning _ warning,'\THIS PROJECT HAS NEVER BEEN SAVED' ]. warning _ 'WARNING', '\Project: ',self name,warning. resp _ (PopUpMenu labels: 'Store anyway\Cancel' withCRs) startUpWithCaption: (warning, '\Please cancel, rename this project, and see what is there.') withCRs. resp ~= 1 ifTrue: [^ nil] ]. ]. "Somewhat ugly workaround for the fact that we deal with local urls here and fully qualified ones in the cache." " self resourceManager adjustToDownloadUrl: self resourceUrl. oldVersion _ self currentVersionNumber." version _ self bumpVersion: maxNumber. " self resourceManager adjustToNewVersion: version from: oldVersion; makeProjectResourcesLocalTo: self resourceUrl." "write locally - now zipped automatically" newName _ FillInTheBlank request: 'File name?' initialAnswer: self versionedFileName. newName isEmpty ifTrue: [^ self beep]. lastSavedAtSeconds _ Time totalSeconds. self exportSegmentFileName: newName directory: localDirectory. ProgressNotification signal: '4:localSaveComplete'. "3 is deep in export logic" ProgressNotification signal: '9999 save complete'. ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/26/2001 18:00'! storeOnServerInnards "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." | resp newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber suppliedPassword oldResourceUrl | self assureIntegerVersion. "Find out what version" primaryServerDirectory _ self primaryServerIfNil: [ (primaryServerDirectory _ self findAFolderToStoreProjectIn) ifNotNil: [ oldResourceUrl _ self resourceUrl. self storeNewPrimaryURL: primaryServerDirectory downloadUrl]. primaryServerDirectory]. localDirectory _ self squeakletDirectory. serverVersionPair _ self class mostRecent: self name onServer: primaryServerDirectory. localVersionPair _ self class mostRecent: self name onServer: localDirectory. maxNumber _ myVersionNumber _ self currentVersionNumber. ProgressNotification signal: '2:versionsDetected'. warning _ ''. myVersionNumber < serverVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) on the server'. maxNumber _ maxNumber max: serverVersionPair second. ]. myVersionNumber < localVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) in the local directory'. maxNumber _ maxNumber max: localVersionPair second. ]. "8 Nov 2000 - only check on the first attempt to publish" myVersionNumber = 0 ifTrue: [ warning isEmpty ifFalse: [ myVersionNumber = 0 ifTrue: [ warning _ warning,'\THIS PROJECT HAS NEVER BEEN SAVED' ]. warning _ 'WARNING', '\Project: ',self name,warning. resp _ (PopUpMenu labels: 'Store anyway\Cancel' withCRs) startUpWithCaption: (warning, '\Please cancel, rename this project, and see what is there.') withCRs. resp ~= 1 ifTrue: [^ nil] ]. ]. version _ self bumpVersion: maxNumber. oldResourceUrl ifNotNil: [self resourceManager adjustToNewServer: self resourceUrl from: oldResourceUrl]. "write locally - now zipped automatically" newName _ self versionedFileName. lastSavedAtSeconds _ Time totalSeconds. self exportSegmentFileName: newName directory: localDirectory. ProgressNotification signal: '4:localSaveComplete'. "3 is deep in export logic" primaryServerDirectory ifNotNil: [ suppliedPassword _ ''. Preferences passwordsOnPublish ifTrue: [ suppliedPassword _ FillInTheBlank requestPassword: 'Project password' ]. [ self writeFileNamed: newName fromDirectory: localDirectory toServer: primaryServerDirectory. ] on: ProjectPasswordNotification do: [ :ex | ex resume: (suppliedPassword ifNil: ['']) ]. ]. ProgressNotification signal: '9999 save complete'. "Later, store with same name on secondary servers. Still can be race conditions. All machines will go through the server list in the same order." "2 to: servers size do: [:aServer | aServer putFile: local named: newName]." ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/20/2001 16:07'! storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." world setProperty: #optimumExtentFromAuthor toValue: world extent. self validateProjectNameIfOK: [ self isCurrentProject ifTrue: ["exit, then do the command" forget ifTrue: [self forgetExistingURL] ifFalse: [urlList isEmptyOrNil ifTrue: [urlList _ parentProject urlList copy]]. ^self armsLengthCommand: #storeOnServerAssumingNameValid withDescription: 'Publishing' ]. self storeOnServerWithProgressInfoOn: aMorphOrNil. ] fixTemps. ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/25/2001 10:50'! tryToFindAServerWithMe | resp primaryServerDirectory | urlList isEmptyOrNil ifTrue: [urlList _ parentProject urlList copy]. [self primaryServer isNil] whileTrue: [ resp _ (PopUpMenu labels: 'Try to find a server\Cancel' withCRs) startUpWithCaption: 'This project thinks it has never been on a server'. resp ~= 1 ifTrue: [^ nil]. (primaryServerDirectory _ self findAFolderToLoadProjectFrom) ifNil: [^nil]. self storeNewPrimaryURL: primaryServerDirectory downloadUrl. ]. ^self primaryServer ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/25/2001 10:55'! url | firstURL | "compose my url on the server" urlList isEmptyOrNil ifTrue: [^'']. firstURL _ urlList first. firstURL isEmpty ifFalse: [ firstURL last == $/ ifFalse: [firstURL _ firstURL, '/']]. ^ firstURL, self versionedFileName ! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/21/2001 15:45'! versionForFileName "Project current versionForFileName" ^self class versionForFileName: self currentVersionNumber! ! !Project methodsFor: 'file in/out' stamp: 'mir 6/21/2001 15:43'! versionedFileName "Project current versionedFileName" ^String streamContents:[:s| s nextPutAll: self name. s nextPutAll: FileDirectory dot. s nextPutAll: self versionForFileName. s nextPutAll: FileDirectory dot. s nextPutAll: self projectExtension. ] ! ! !Project methodsFor: 'resources' stamp: 'mir 6/21/2001 15:43'! resourceDirectoryName "Project current resourceDirectoryName" ^String streamContents:[:s| s nextPutAll: self name. s nextPutAll: FileDirectory dot. s nextPutAll: self versionForFileName. ] ! ! !Project methodsFor: 'resources' stamp: 'mir 6/26/2001 17:34'! resourceUrl "compose my base url for resources on the server" | firstURL | " primaryServer _ self primaryServerIfNil: [^'']. firstURL _ primaryServer altUrl ifNil: [primaryServer url]." firstURL _ self downloadUrl. firstURL isEmpty ifFalse: [firstURL last == $/ ifFalse: [firstURL _ firstURL, '/']]. ^ firstURL, self resourceDirectoryName , '/' ! ! !Project methodsFor: 'resources' stamp: 'mir 6/18/2001 16:19'! startResourceLoading "Abort loading resources" resourceManager ifNil:[^self]. resourceManager adjustToDownloadUrl: self resourceUrl. resourceManager startDownload! ! !Project class methodsFor: 'utilities' stamp: 'mir 6/21/2001 15:44'! versionForFileName: version "Project versionForFileName: 7" | v | ^String streamContents:[:s| v _ version printString. v size < 3 ifTrue:[v _ '0', v]. v size < 3 ifTrue:[v _ '0', v]. s nextPutAll: v. ] ! ! !ProjectLoading class methodsFor: 'as yet unclassified' stamp: 'mir 5/22/2001 17:52'! bestAccessToFileName: aFileName andDirectory: aDirectoryOrURL | localDir | ((localDir _ Project squeakletDirectory) fileExists: aFileName) ifTrue: [ ^{localDir readOnlyFileNamed: aFileName. localDir} ]. (aDirectoryOrURL isKindOf: String) ifTrue: [ ^{(Project serverFileFromURL: aDirectoryOrURL) asStream. nil} ]. ^{aDirectoryOrURL readOnlyFileNamed: aFileName. aDirectoryOrURL} ! ! !ProjectLoading class methodsFor: 'as yet unclassified' stamp: 'mir 6/18/2001 22:49'! openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." | morphOrList proj trusted localDir projStream archive mgr projectsToBeDeleted | (preStream isNil or: [preStream size = 0]) ifTrue: [ ProgressNotification signal: '9999 about to enter project'. "the hard part is over" ^self inform: 'It looks like a problem occurred while getting this project. It may be temporary, so you may want to try again,' ]. ProgressNotification signal: '2:fileSizeDetermined ',preStream size printString. preStream isZipArchive ifTrue:[ archive _ ZipArchive new readFrom: preStream. projStream _ self projectStreamFromArchive: archive] ifFalse:[projStream _ preStream]. trusted _ SecurityManager default positionToSecureContentsOf: projStream. trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[ (preStream respondsTo: #close) ifTrue:[preStream close]. ^self]]. localDir _ Project squeakletDirectory. aFileName ifNotNil: [ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName ~= localDir pathName]) ifTrue: [ localDir deleteFileNamed: aFileName. (localDir fileNamed: aFileName) nextPutAll: preStream allContentsWithoutSideEffects; close. ]. ]. morphOrList _ projStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ProgressNotification signal: '3:unzipped'. ResourceCollector current: ResourceCollector new. morphOrList _ morphOrList fileInObjectAndCode. mgr _ ResourceManager new initializeFrom: ResourceCollector current. mgr registerUnloadedResources. archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. (preStream respondsTo: #close) ifTrue:[preStream close]. ResourceCollector current: nil. ProgressNotification signal: '4:filedIn'. ProgressNotification signal: '9999 about to enter project'. "the hard part is over" (morphOrList isKindOf: ImageSegment) ifTrue: [ proj _ morphOrList arrayOfRoots detect: [:mm | mm class == Project] ifNone: [^self inform: 'No project found in this file']. proj resourceManager: mgr. proj versionFrom: preStream. proj lastDirectory: aDirectoryOrNil. CurrentProjectRefactoring currentBeParentTo: proj. projectsToBeDeleted _ OrderedCollection new. existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ChangeSorter allChangeSets add: proj changeSet. ProjectView openAndEnter: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName. projectsToBeDeleted add: existingView project. ]. (existingView owner isKindOf: SystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ChangeSorter allChangeSets add: proj changeSet. Project current projectParameters at: #deleteWhenEnteringNewProject ifPresent: [ :ignored | projectsToBeDeleted add: Project current. Project current removeParameter: #deleteWhenEnteringNewProject. ]. projectsToBeDeleted isEmpty ifFalse: [ proj projectParameters at: #projectsToBeDeleted put: projectsToBeDeleted. ]. ^ ProjectEntryNotification signal: proj ]. (morphOrList isKindOf: SqueakPage) ifTrue: [ morphOrList _ morphOrList contentsMorph ]. (morphOrList isKindOf: PasteUpMorph) ifFalse: [ ^ self inform: 'This is not a PasteUpMorph or exported Project.' ]. (Project newMorphicOn: morphOrList) enter ! ! !ProjectNavigationMorph methodsFor: 'the buttons' stamp: 'RAA 2/17/2001 12:43'! buttonPublish ^self makeButton: 'PUBLISH IT!!' balloonText: 'Publish this project. Save it where it came from (server, hard disk, etc.) ' for: #publishProjectSimple! ! !ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mir 6/27/2001 22:14'! doPublishButtonMenuEvent: evt | menu selection | menu _ CustomMenu new. menu add: 'Publish' action: [self publishProjectSimple]; add: 'Publish As...' action: [self publishProjectAs]; add: 'Publish As (more places)...' action: [self publishDifferent]; add: 'edit project info' action: [self editProjectInfo]. selection _ menu build startUpCenteredWithCaption: 'Publish options'. selection ifNil: [^self]. selection value. ! ! !ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mir 6/25/2001 16:53'! publishProjectAs self publishStyle: #limitedSuperSwikiPublishDirectoryList forgetURL: false withRename: true! ! !ProjectNavigationMorph methodsFor: 'the actions' stamp: 'RAA 5/16/2001 17:45'! publishProjectSimple self publishStyle: #limitedSuperSwikiPublishDirectoryList forgetURL: false withRename: false! ! !ProjectNavigationMorph methodsFor: 'the actions' stamp: 'mir 6/25/2001 14:36'! publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean | w saveOwner primaryServer rename | w _ self world ifNil: [^1 beep]. w setProperty: #SuperSwikiPublishOptions toValue: aSymbol. primaryServer _ w project primaryServerIfNil: [nil]. rename _ ((primaryServer notNil and: [primaryServer acceptsUploads]) not) or: [renameBoolean]. w setProperty: #SuperSwikiRename toValue: rename. saveOwner _ owner. self delete. w project storeOnServerShowProgressOn: self forgetURL: aBoolean | rename. saveOwner addMorphFront: self.! ! !ProjectViewMorph methodsFor: 'drawing' stamp: 'mir 6/19/2001 10:19'! safeProjectName: aString self addProjectNameMorphFiller. self isTheRealProjectPresent ifFalse: [^ self]. project renameTo: aString. self setProperty: #SafeProjectName toValue: project name. self updateNamePosition. (owner isKindOf: SystemWindow) ifTrue: [owner setLabel: aString].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'mir 6/21/2001 14:06'! objectForDataStream: refStream fromForm: aForm "Return a replacement for aForm to be stored instead" | stub fName copy loc fullSize nameAndSize | "First check if the form is one of the intrinsic Squeak forms" stub _ internalStubs at: aForm ifAbsent:[nil]. stub ifNotNil:[ refStream replace: aForm with: stub. ^stub]. "Now see if we have created the stub already (this may happen if for instance some form is shared)" stub _ originalMap at: aForm ifAbsent:[nil]. stub ifNotNil:[^aForm]. aForm hibernate. (aForm bits byteSize < 4096) ifTrue:[^aForm]. "too small to be of interest" "Create our stub form" stub _ FormStub extent: (aForm width min: 32) @ (aForm height min: 32) depth: (aForm depth min: 8). aForm displayScaledOn: stub. aForm hibernate. "Create a copy of the original form which we use to store those bits" copy _ Form extent: aForm extent depth: aForm depth bits: nil. copy setResourceBits: aForm bits. "Get the locator for the form (if we have any)" loc _ locatorMap at: aForm ifAbsent:[nil]. "Store the resource file" nameAndSize _ self writeResourceForm: copy locator: loc. fName _ nameAndSize first. fullSize _ nameAndSize second. ProgressNotification signal: '2:resourceFound' extra: stub. stub hibernate. "See if we need to assign a new locator" (loc notNil and:[loc hasRemoteContents not]) ifTrue:[ "The locator describes some local resource. If we're preparing to upload the entire project to a remote server, make it a remote URL instead." " (baseUrl isEmpty not and:[baseUrl asUrl hasRemoteContents]) ifTrue:[loc urlString: baseUrl, fName]. " baseUrl isEmpty not ifTrue:[loc urlString: self resourceDirectory , fName]]. loc ifNil:[ loc _ ResourceLocator new urlString: self resourceDirectory , fName. locatorMap at: aForm put: loc]. loc localFileName: (localDirectory fullNameFor: fName). loc resourceFileSize: fullSize. stub locator: loc. "Map old against stub form" aForm setResourceBits: stub. originalMap at: aForm put: copy. stubMap at: stub put: aForm. locatorMap at: aForm put: loc. "note: *must* force aForm in out pointers if in IS or else won't get #comeFullyUpOnReload:" refStream replace: aForm with: aForm. ^aForm! ! !ResourceCollector methodsFor: 'accessing' stamp: 'mir 6/21/2001 14:51'! resourceDirectory resourceDirectory ifNil: [resourceDirectory _ self baseUrl copyFrom: 1 to: (self baseUrl lastIndexOf: $/)]. ^resourceDirectory! ! !ResourceCollector methodsFor: 'resource writing' stamp: 'mir 6/22/2001 17:46'! writeResourceForm: aForm fromLocator: aLocator "The given form has been externalized before. If it was reasonably compressed, use the bits of the original data - this allows us to recycle GIF, JPEG, PNG etc. data without using the internal compression (which is in most cases inferior). If necessary the data will be retrieved from its URL location. This retrieval is done only if the resouce comes from either * the local disk (in which case the file has never been published) * the browser cache (in which case we don't cache the resource locally) In any other case we will *not* attempt to retrieve it, because doing so can cause the system to connect to the network which is probably not what we want. It should be a rare case anyways; could only happen if one clears the squeak cache selectively." | fName fStream url data | "Try to be smart about the name of the file" fName _ (aLocator urlString includes: $:) ifTrue: [ url _ aLocator urlString asUrl. url path last] ifFalse: [aLocator urlString]. fName isEmptyOrNil ifFalse:[fName _ fName asFileName]. (fName isEmptyOrNil or:[localDirectory isAFileNamed: fName]) ifTrue:[ "bad luck -- duplicate name" fName _ localDirectory nextNameFor:'resource' extension: (FileDirectory extensionFor: aLocator urlString)]. "Let's see if we have cached it locally" ResourceManager lookupCachedResource: self baseUrl , aLocator urlString ifPresentDo:[:stream| data _ stream upToEnd. ]. data ifNil:[ "We don't have it cached locally. Retrieve it from its original location." ((url notNil and: [url hasRemoteContents]) and:[HTTPClient isRunningInBrowser not]) ifTrue:[^nil]. "see note above" data _ HTTPLoader default retrieveContentsFor: aLocator urlString. data ifNil:[^nil]. data _ data content. ]. data size > aForm bits byteSize ifTrue:[^nil]. fStream _ localDirectory newFileNamed: fName. fStream nextPutAll: data. fStream close. ^{fName. data size}! ! !ResourceCollector methodsFor: 'resource writing' stamp: 'ar 5/30/2001 20:09'! writeResourceForm: aForm locator: aLocator "Store the given form on a file. Return an array with the name and the size of the file" | fName fStream fullSize result | aLocator ifNotNil:[ result _ self writeResourceForm: aForm fromLocator: aLocator. result ifNotNil:[^result] "else fall through" ]. fName _ localDirectory nextNameFor:'resource' extension:'form'. fStream _ localDirectory newFileNamed: fName. fStream binary. aForm storeResourceOn: fStream. "Compress contents here" fStream position: 0. fStream compressFile. localDirectory deleteFileNamed: fName. localDirectory rename: fName, FileDirectory dot, 'gz' toBe: fName. fStream _ localDirectory readOnlyFileNamed: fName. fullSize _ fStream size. fStream close. ^{fName. fullSize}! ! !ResourceLocator methodsFor: 'accessing' stamp: 'mir 6/7/2001 16:36'! adjustToDownloadUrl: downloadUrl "Adjust to the fully qualified URL for this resource." self urlString: (self urlString asUrlRelativeTo: downloadUrl asUrl) toText unescapePercents! ! !ResourceLocator methodsFor: 'accessing' stamp: 'mir 6/19/2001 16:55'! adjustToRename: newName from: oldName "Adjust to the fully qualified URL for this resource." self urlString: (self urlString copyReplaceAll: oldName with: newName)! ! !ResourceManager methodsFor: 'initialize' stamp: 'mir 6/18/2001 22:49'! initializeFrom: aCollector "Initialize the receiver from the given resource collector. None of the resources have been loaded yet, so make register all resources as unloaded." | newLoc | aCollector stubMap keysAndValuesDo:[:stub :res| newLoc _ stub locator. resourceMap at: newLoc put: res. "unloaded add: newLoc." ].! ! !ResourceManager methodsFor: 'accessing' stamp: 'mir 6/26/2001 17:33'! adjustToDownloadUrl: downloadUrl "Adjust the resource manager to the current download location. A project might have been moved manually to a different location or server." downloadUrl isEmptyOrNil ifTrue: [^self]. self resourceMap keysDo:[:locator | locator adjustToDownloadUrl: downloadUrl]. self resourceMap rehash. unloaded rehash! ! !ResourceManager methodsFor: 'accessing' stamp: 'mir 6/26/2001 17:53'! adjustToNewServer: newResourceUrl from: oldResourceUrl "Adjust the resource manager to the current download location. A project might have been moved manually to a different location or server." | urlMap oldUrl newUrl | newResourceUrl isEmptyOrNil ifTrue: [^self]. urlMap _ Dictionary new. self resourceMap keysDo: [:locator | oldUrl _ locator urlString asUrlRelativeTo: oldResourceUrl asUrl. newUrl _ locator urlString asUrlRelativeTo: newResourceUrl asUrl. oldUrl ~= newUrl ifTrue: [urlMap at: oldUrl asString unescapePercents put: newUrl asString unescapePercents]]. self resourceMap rehash. unloaded rehash. urlMap keysAndValuesDo: [:old :new | ResourceManager renameCachedResource: old to: new]! ! !ResourceManager methodsFor: 'accessing' stamp: 'mir 6/21/2001 16:02'! adjustToRename: newName from: oldName "Adjust the resource manager to the current download location. A project might have been moved manually to a different location or server." | urlMap oldUrl | newName isEmptyOrNil ifTrue: [^self]. urlMap _ Dictionary new. self resourceMap keysDo: [:locator | oldUrl _ locator urlString. locator adjustToRename: newName from: oldName. urlMap at: oldUrl put: locator urlString]. self resourceMap rehash. unloaded rehash. urlMap keysAndValuesDo: [:old :new | ResourceManager renameCachedResource: old to: new]! ! !ResourceManager methodsFor: 'accessing' stamp: 'mir 6/26/2001 17:32'! makeAllProjectResourcesLocalTo: resourceUrl "Change the urls in the resource locators so project specific resources are stored and referenced locally. Project specific resources are all those that are kept locally in any of the project's versions." | locators locUrl locBase lastSlash projectBase localResource | "Construct the version neutral project base" resourceUrl isEmptyOrNil ifTrue: [^self]. projectBase _ resourceUrl copyFrom: 1 to: (resourceUrl lastIndexOf: $.) - 1. locators _ OrderedCollection new. self resourceMap keysAndValuesDo:[:loc :res | res ifNotNil: [locators add: loc]]. locators do: [:locator | locUrl _ locator urlString. locUrl ifNotNil: [ lastSlash _ locUrl lastIndexOf: $/. locBase _ locUrl copyFrom: 1 to: lastSlash - 1. locBase _ locBase copyFrom: 1 to: (((locBase lastIndexOf: $.) - 1) max: 0). projectBase = locBase ifTrue: [ localResource _ locUrl copyFrom: lastSlash+1 to: locUrl size. "Update the cache entry to point to the new resource location" ResourceManager renameCachedResource: locUrl to: (resourceUrl , localResource). locator urlString: localResource]]]. self resourceMap rehash ! ! !ResourceManager methodsFor: 'accessing' stamp: 'mir 6/18/2001 22:40'! makeProjectResourcesLocalTo: projectBase "Change the urls in the resource locators so project specific resources are stored and referenced locally. Project specific resources are all those, that are kept locally in any of the project's versions." | locators locUrl locBase lastSlash | locators _ OrderedCollection new. self resourceMap keysAndValuesDo:[:loc :res | res ifNotNil: [locators add: loc]]. "locators select: [:locator | locUrl _ locator urlString. locUrl ifNotNil: [ locBase _ locUrl copyFrom: 1 to: locUrl size - (3 + Project projectExtension size + 2). projectBase = locBase]]" locators do: [:locator | locUrl _ locator urlString. locUrl ifNotNil: [ lastSlash _ locUrl lastIndexOf: $/. locBase _ locUrl copyFrom: 1 to: lastSlash - 1. projectBase = locBase ifTrue: [locator urlString: (locUrl copyFrom: lastSlash+1 to: locUrl size)]]]. self resourceMap rehash ! ! !ResourceManager methodsFor: 'loading' stamp: 'ar 5/30/2001 23:11'! installResource: aResource from: aStream locator: loc | repl | aResource ifNil:[^false]. "it went away, so somebody might have deleted it" (aStream == nil or:[aStream size = 0]) ifTrue:[^false]. "error?!!" repl _ aResource clone readResourceFrom: aStream asUnZippedStream. repl ifNotNil:[ aResource replaceByResource: repl. unloaded remove: loc. loaded add: loc. ^true ]. ^false! ! !ResourceManager methodsFor: 'loading' stamp: 'mir 6/18/2001 21:53'! loaderProcess | loader requests req locator resource stream | loader _ HTTPLoader default. requests _ Dictionary new. self prioritizedUnloadedResources do:[:loc| req _ HTTPLoader httpRequestClass for: loc urlString in: loader. loader addRequest: req. requests at: req put: loc]. [stopFlag or:[requests isEmpty]] whileFalse:[ stopSemaphore waitTimeoutMSecs: 500. requests keys "need a copy" do:[:r| r isSemaphoreSignaled ifTrue:[ locator _ requests at: r. requests removeKey: r. stream _ r contentStream. resource _ resourceMap at: locator ifAbsent:[nil]. self class cacheResource: locator urlString stream: stream. self installResource: resource from: stream locator: locator. (resource isKindOf: Form) ifTrue:[ WorldState addDeferredUIMessage: self formChangedReminder] ifFalse: [self halt]. ]. ]. ]. "Either done downloading or terminating process" stopFlag ifTrue:[loader abort]. loaderProcess _ nil. stopSemaphore _ nil.! ! !ResourceManager methodsFor: 'loading' stamp: 'ar 5/30/2001 23:17'! preLoadFromArchive: aZipArchive cacheName: aFileName "Load the resources from the given zip archive" | orig nameMap resMap loc stream | resMap _ Dictionary new. nameMap _ Dictionary new. unloaded do:[:locator| locator localFileName: nil. nameMap at: locator urlString put: locator. resMap at: locator urlString put: (resourceMap at: locator)]. aZipArchive members do:[:entry| stream _ nil. orig _ resMap at: entry fileName ifAbsent:[nil]. loc _ nameMap at: entry fileName ifAbsent:[nil]. "note: orig and loc may be nil for non-resource members" (orig notNil and:[loc notNil]) ifTrue:[ stream _ entry contentStream. self installResource: orig from: stream locator: loc. stream reset. aFileName ifNil:[self class cacheResource: loc urlString stream: stream] ifNotNil:[self class cacheResource: loc urlString inArchive: aFileName]]. ].! ! !ResourceManager methodsFor: 'loading' stamp: 'mir 6/18/2001 22:49'! registerUnloadedResources resourceMap keys do: [:newLoc | unloaded add: newLoc] ! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'ar 5/30/2001 23:21'! cacheResource: urlString inArchive: archiveName "Remember the given url as residing in the given archive" | fd file fullName | fullName _ 'zip://', archiveName. ((self resourceCache at: urlString ifAbsent:[#()]) anySatisfy:[:cache| cache = fullName]) ifTrue:[^self]. "don't cache twice" fd _ Project squeakletDirectory. "update cache" file _ [fd oldFileNamed: self resourceCacheName] on: FileDoesNotExistException do:[:ex| fd forceNewFileNamed: self resourceCacheName]. file setToEnd. file nextPutAll: urlString; cr. file nextPutAll: fullName; cr. file close. self addCacheLocation: fullName for: urlString.! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'ar 5/30/2001 23:23'! cacheResource: urlString stream: aStream | fd localName file buf | HTTPClient shouldUsePluginAPI ifTrue:[^self]. "use browser cache" (self resourceCache at: urlString ifAbsent:[#()]) size > 0 ifTrue:[^self]. "don't waste space" fd _ Project squeakletDirectory. localName _ fd nextNameFor: 'resource' extension:'cache'. file _ fd forceNewFileNamed: localName. buf _ String new: 10000. [aStream atEnd] whileFalse:[ buf _ aStream next: buf size into: buf. file nextPutAll: buf. ]. file close. "update cache" file _ [fd oldFileNamed: self resourceCacheName] on: FileDoesNotExistException do:[:ex| fd forceNewFileNamed: self resourceCacheName]. file setToEnd. file nextPutAll: urlString; cr. file nextPutAll: localName; cr. file close. self addCacheLocation: localName for: urlString. aStream position: 0. ! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'mir 6/21/2001 17:26'! lookupCachedResource: urlString ifPresentDo: streamBlock "See if we have cached the resource described by the given url and if so, evaluate streamBlock with the cached resource." | file dir candidates | CachedResources ifNil:[^self]. candidates _ CachedResources at: urlString ifAbsent:[nil]. (candidates isNil or:[candidates size = 0]) ifTrue:[^self]. "First, try non-zip members (faster since no decompression is involved)" candidates _ (candidates reject:[:each| each beginsWith: 'zip://']), (candidates select:[:each| each beginsWith: 'zip://']). dir _ Project squeakletDirectory. candidates do:[:fileName| file _ self loadResource: urlString fromCacheFileNamed: fileName in: dir. file ifNotNil:[ [streamBlock value: file] ensure:[file close]. ^self]]. ! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'mir 6/21/2001 22:49'! lookupOriginalResourceCacheEntry: resourceFileName for: resourceUrl "See if we have cached the resource described by the given url in an earlier version of the same project on the same server. In that case we don't need to upload it again but rather link to it." | candidates resourceBase resourceMatch matchingUrls | CachedResources ifNil:[^nil]. "Strip the version number from the resource url" resourceBase _ resourceUrl copyFrom: 1 to: (resourceUrl lastIndexOf: $.) . "Now collect all urls that have the same resource base" resourceMatch _ resourceBase , '*/' , resourceFileName. matchingUrls _ self resourceCache keys select: [:entry | (resourceMatch match: entry) and: [(entry beginsWith: resourceUrl) not]]. matchingUrls isEmpty ifTrue: [^nil]. matchingUrls asSortedCollection do: [:entry | candidates _ (self resourceCache at: entry). candidates isEmptyOrNil ifFalse: [candidates do: [:candidate | candidate = resourceFileName ifTrue: [^entry]]]]. ^nil! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'ar 5/30/2001 23:28'! reloadCachedResources "ResourceManager reloadCachedResources" "Reload cached resources from the disk" | fd files stream url localName storeBack archiveName | CachedResources _ Dictionary new. fd _ Project squeakletDirectory. files _ fd fileNames asSet. stream _ [fd readOnlyFileNamed: self resourceCacheName] on: FileDoesNotExistException do:[:ex| fd forceNewFileNamed: self resourceCacheName]. stream size < 50000 ifTrue:[stream _ ReadStream on: stream contentsOfEntireFile]. storeBack _ false. [stream atEnd] whileFalse:[ url _ stream upTo: Character cr. localName _ stream upTo: Character cr. (localName beginsWith: 'zip://') ifTrue:[ archiveName _ localName copyFrom: 7 to: localName size. (files includes: archiveName) ifTrue:[self addCacheLocation: localName for: url] ifFalse:[storeBack _ true]. ] ifFalse:[ (files includes: localName) ifTrue:[self addCacheLocation: localName for: url] ifFalse:[storeBack _ true] ]. ]. (stream respondsTo: #close) ifTrue:[stream close]. storeBack ifTrue:[ stream _ fd forceNewFileNamed: self resourceCacheName. CachedResources keysAndValuesDo:[:urlString :cacheLocs| cacheLocs do:[:cacheLoc| stream nextPutAll: urlString; cr. stream nextPutAll: cacheLoc; cr]. ]. stream close. ].! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'mir 6/20/2001 16:25'! renameCachedResource: urlString to: newUrlString "A project was renamed. Reflect this change by duplicating the cache entry to the new url." | candidates | CachedResources ifNil:[^self]. candidates _ CachedResources at: urlString ifAbsent:[nil]. (candidates isNil or:[candidates size = 0]) ifTrue:[^self]. candidates do: [:candidate | self addCacheLocation: candidate for: newUrlString]! ! !ResourceManager class methodsFor: 'resource caching' stamp: 'ar 5/30/2001 23:22'! resourceCache ^CachedResources ifNil:[CachedResources _ Dictionary new]! ! !ResourceManager class methodsFor: 'private-resources' stamp: 'ar 5/30/2001 23:07'! addCacheLocation: aString for: urlString CachedResources at: urlString put: ((CachedResources at: urlString ifAbsent:[#()]) copyWith: aString)! ! !ResourceManager class methodsFor: 'private-resources' stamp: 'ar 5/30/2001 23:55'! loadResource: urlString fromCacheFileNamed: fileName in: dir | archiveName file archive | (fileName beginsWith: 'zip://') ifTrue:[ archiveName _ fileName copyFrom: 7 to: fileName size. archive _ [dir readOnlyFileNamed: archiveName] on: FileDoesNotExistException do:[:ex| ex return: nil]. archive ifNil:[^nil]. archive isZipArchive ifTrue:[ archive _ ZipArchive new readFrom: archive. file _ archive members detect:[:any| any fileName = urlString] ifNone:[nil]]. file ifNotNil:[file _ file contentStream]. archive close. ] ifFalse:[ file _ [dir readOnlyFileNamed: fileName] on: FileDoesNotExistException do:[:ex| ex return: nil]. ]. ^file! ! !ServerDirectory methodsFor: 'accessing' stamp: 'mir 6/25/2001 12:43'! acceptsUploads: aBoolean "Do nothing yet"! ! !ServerDirectory methodsFor: 'accessing' stamp: 'mir 6/25/2001 10:45'! downloadUrl "The url under which files will be accessible." ^(self altUrl ifNil: [self realUrl] ifNotNil: [self altUrl]) , '/'! ! !ServerDirectory methodsFor: 'accessing' stamp: 'mir 6/25/2001 17:16'! typeForPrefs ^self typeWithDefault! ! !ServerDirectory methodsFor: 'file-in/out' stamp: 'mir 6/26/2001 12:14'! storeServerEntryOn: stream stream nextPutAll: 'name:'; tab; nextPutAll: (ServerDirectory nameForServer: self); cr; nextPutAll: 'directory:'; tab; nextPutAll: self directory; cr; nextPutAll: 'type:'; tab; nextPutAll: self typeForPrefs; cr; nextPutAll: 'server:'; tab; nextPutAll: self server; cr. group ifNotNil: [stream nextPutAll: 'group:'; tab; nextPutAll: self groupName; cr]. self user ifNotNil: [stream nextPutAll: 'user:'; tab; nextPutAll: self user; cr]. self altUrl ifNotNil: [stream nextPutAll: 'url:'; tab; nextPutAll: self altUrl; cr]. self loaderUrl ifNotNil: [stream nextPutAll: 'loaderUrl:'; tab; nextPutAll: self loaderUrl; cr]. self acceptsUploads ifTrue: [stream nextPutAll: 'acceptsUploads:'; tab; nextPutAll: 'true'; cr]! ! !ServerDirectory methodsFor: 'testing' stamp: 'mir 6/25/2001 12:52'! acceptsUploads ^true! ! !ProjectSwikiServer methodsFor: 'testing' stamp: 'mir 6/25/2001 12:40'! acceptsUploads ^acceptsUploads == true! ! !ProjectSwikiServer methodsFor: 'accessing' stamp: 'mir 6/25/2001 12:40'! acceptsUploads: aBoolean acceptsUploads _ aBoolean! ! !HTTPServerDirectory methodsFor: 'file directory' stamp: 'mir 6/5/2001 16:40'! pathName "Path name as used in reading the file. with slashes for ftp, with local file delimiter (:) for a file: url" urlObject ifNotNil: [^ urlObject pathForFile]. directory size = 0 ifTrue: [^ server]. ^(directory at: 1) = self pathNameDelimiter ifTrue: [server, directory] ifFalse: [user ifNil: [server, self pathNameDelimiter asString, directory] ifNotNil: [user, '@', server, self pathNameDelimiter asString, directory]]! ! !HTTPServerDirectory methodsFor: 'file directory' stamp: 'mir 5/30/2001 19:55'! readOnlyFileNamed: aName ^self oldFileNamed: aName! ! !HTTPServerDirectory methodsFor: 'accessing' stamp: 'mir 5/30/2001 19:47'! dirListUrl ^self altUrl , '/'! ! !HTTPServerDirectory methodsFor: 'accessing' stamp: 'mir 6/25/2001 17:17'! typeForPrefs ^'http'! ! !ServerDirectory class methodsFor: 'available servers' stamp: 'mir 5/24/2001 17:49'! addLocalProjectDirectory: aFileDirectory self localProjectDirectories add: aFileDirectory ! ! !ServerDirectory class methodsFor: 'available servers' stamp: 'mir 5/24/2001 17:48'! localProjectDirectories LocalProjectDirectories ifNil: [LocalProjectDirectories _ OrderedCollection new]. ^LocalProjectDirectories! ! !ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:45'! nameForServer: aServer ^self servers keyAtValue: aServer! ! !ServerDirectory class methodsFor: 'available servers' stamp: 'mir 5/24/2001 17:49'! resetLocalProjectDirectories LocalProjectDirectories _ nil! ! !ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 14:29'! serverForURL: aURL | serversForURL server urlPath serverPath relPath | serversForURL _ self servers values select: [:each | (aURL beginsWith: each downloadUrl) or: [(aURL beginsWith: each realUrl) or: [aURL , '/' beginsWith: each downloadUrl]]]. serversForURL isEmpty ifTrue: [^nil]. server _ serversForURL first. urlPath _ aURL asUrl path. (urlPath isEmpty not and: [urlPath last isEmpty]) ifTrue: [urlPath removeLast]. serverPath _ server downloadUrl asUrl path. (serverPath isEmpty not and: [serverPath last isEmpty]) ifTrue: [serverPath removeLast]. urlPath size < serverPath size ifTrue: [^nil]. relPath _ String new. serverPath size +1 to: urlPath size do: [:i | relPath _ relPath , '/' , (urlPath at: i)]. ^relPath isEmpty ifTrue: [server] ifFalse: [server directoryNamed: (relPath copyFrom: 2 to: relPath size)]! ! !ServerDirectory class methodsFor: 'server groups' stamp: 'mir 6/26/2001 11:55'! serversInGroupNamed: nameString "Return the servers in the group of this name." "ServerDirectory serversInGroupNamed: 'Squeak Public Updates' " ^self servers values select: [:server | nameString = server groupName]. ! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'mir 5/30/2001 15:28'! fetchExternalSettingsIn: aDirectory "Scan for server configuration files" "ServerDirectory fetchExternalSettingsIn: (FileDirectory default directoryNamed: 'prefs')" | serverConfDir stream | (aDirectory directoryExists: self serverConfDirectoryName) ifFalse: [^self]. self resetLocalProjectDirectories. serverConfDir _ aDirectory directoryNamed: self serverConfDirectoryName. serverConfDir fileNames do: [:fileName | stream _ serverConfDir readOnlyFileNamed: fileName. stream ifNotNil: [ [self parseServerEntryFrom: stream] ifError: [:err :rcvr | ]. stream close]]! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'mir 5/24/2001 15:34'! parseServerEntryArgsFrom: stream "Args are in the form : delimited by end of line. It's not a very robust format and should be replaced by something like XML later. But it avoids evaluating the entries for security reasons." | entries lineStream entryName entryValue | entries _ Dictionary new. stream skipSeparators. [stream atEnd] whileFalse: [ lineStream _ ReadStream on: stream nextLine. entryName _ lineStream upTo: $:. lineStream skipSeparators. entryValue _ lineStream upToEnd. (entryName isEmptyOrNil or: [entryValue isEmptyOrNil]) ifFalse: [entries at: entryName put: entryValue withoutTrailingBlanks]. stream skipSeparators]. ^entries! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'mir 6/26/2001 12:13'! parseServerEntryFrom: stream | server type directory entries serverName | entries _ self parseServerEntryArgsFrom: stream. serverName _ entries at: 'name' ifAbsent: [^nil]. directory _ entries at: 'directory' ifAbsent: [^nil]. type _ entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ ^self addLocalProjectDirectory: (FileDirectory default directoryNamed: directory)]. type = 'bss' ifTrue: [server _ SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server _ HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server _ ServerDirectory new type: #ftp]. server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. ServerDirectory addServer: server named: serverName. ! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'mir 5/24/2001 17:08'! serverConfDirectoryName ^'knownServers'! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'mir 6/26/2001 09:49'! storeCurrentServersIn: aDirectory | file | self servers do: [:each | file _ aDirectory fileNamed: (ServerDirectory nameForServer: each). each storeServerEntryOn: file. file close]. self localProjectDirectories do: [:each | file _ aDirectory fileNamed: each localName. each storeServerEntryOn: file. file close]. ! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'mir 6/26/2001 00:19'! transferServerDefinitionsToExternal "ServerDirectory transferServerDefinitionsToExternal" | serverDir | serverDir _ ExternalSettings preferenceDirectory directoryNamed: self serverConfDirectoryName. serverDir assureExistance. ServerDirectory storeCurrentServersIn: serverDir! ! !ServerDirectory class methodsFor: 'class initialization' stamp: 'mir 6/25/2001 18:46'! initialize "ServerDirectory initialize" "ServerDirectory resetLocalProjectDirectories. Servers _ Dictionary new." ExternalSettings registerClient: self! ! !ServerDirectory class methodsFor: 'class initialization' stamp: 'mir 6/25/2001 18:42'! startUp "Look for external server defs and load them." "ServerDirectory startUp" | prefDir prefDirName | prefDirName _ 'prefs'. prefDir _ (FileDirectory default directoryExists: prefDirName) ifTrue: [FileDirectory default directoryNamed: prefDirName] ifFalse: [(FileDirectory on: Smalltalk vmPath) directoryNamed: prefDirName]. "Use the potential external settings API here." self fetchExternalSettingsIn: prefDir! ! !SuperSwikiServer methodsFor: 'accessing' stamp: 'mir 6/25/2001 17:17'! typeForPrefs ^'bss'! ! ServerDirectory initialize! !ServerDirectory reorganize! ('do ftp' fileExists: getDirectory getFileList getFileNamed: getFileNamed:into: getOnlyBuffer:from: openFTP openNoDataFTP putFile:named: putFile:named:retry: putFileSavingOldVersion:named: quit sleep wakeUp) ('updates' checkNames: checkServersWithPrefix:andParseListInto: exportUpdatesExcept: outOfDate: putUpdate: putUpdateMulti:fromDirectory: updateInstallVersion:) ('accessing' acceptsUploads: altUrl altUrl: bareDirectory copy directory directory: directoryObject downloadUrl fullPath: isTypeFTP isTypeFile isTypeHTTP loaderUrl loaderUrl: moniker moniker: password password: printOn: realUrl server server: slashDirectory type: typeForPrefs typeWithDefault url url: urlObject urlObject: user user:) ('file directory' asServerFileNamed: createDirectory: deleteDirectory: deleteFileNamed: directoryNamed: directoryNames entries exists fileAndDirectoryNames fileNamed: fileNames fullNameFor: getOnly:from: includesKey: localNameFor: newFileNamed: oldFileNamed: oldFileOrNoneNamed: on: pathName pathNameDelimiter pathParts readOnlyFileNamed: rename:toBe: serverDelimiter splitName:to: streamOnBeginningOf:) ('server groups' closeGroup convertGroupName groupName groupName: openGroup serversInGroup) ('initialize' fromUser reset) ('squeaklets' directoryWrapperClass moveAllButYoungest:in:to: upLoadProject:members:retry: upLoadProject:named:resourceUrl:retry: updateProjectInfoFor:) ('file-in/out' storeServerEntryOn:) ('testing' acceptsUploads isProjectSwiki) ! ResourceManager removeSelector: #preLoadFromArchive:! Object subclass: #ResourceCollector instanceVariableNames: 'stubMap originalMap locatorMap localDirectory baseUrl resourceDirectory internalStubs ' classVariableNames: 'Current ' poolDictionaries: '' category: 'System-Support'!