'From Squeak3.2alpha of 8 October 2001 [latest update: #4418] on 16 October 2001 at 4:21:43 pm'! Object subclass: #ModuleInstaller instanceVariableNames: 'startModuleRef operation createdModules downloadedModules loadedModules installedObjects progressIndicator progressValue ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules-Repositories'! !ModuleInstaller commentStamp: '' prior: 0! I handle downloading, (un)loading, and (de)activating modules. I traverse the graph of modules and their neighbors, compute what operations are needed and perform them in a safe and controlled manner, while collecting information about what is done, so that e.g. an interrupted or failed operation can be gracefully reverted. A downloaded module is present in the local cache. A loaded module is present in the image, unloading it takes it out from the image. A loaded module can be active or inactive: Multiple versions of the same module may be loaded simultaneously, but only one may be active at one time. This is the basis for conflict resolution. An active DeltaModule has its changes installed into its base module, which also causes a different version of the base module to be active. A loaded but inactive DeltaModule does not have its changes installed into the base module at the current time. ! Object subclass: #Repository instanceVariableNames: 'module directory isStandalone ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules-Repositories'! !Repository commentStamp: '' prior: 0! I am an abstract file system-based repository. I know how to robustly store, access and manage the files for a module, including what files are needed, the file names to use and so on. I also know how to structure the repository into a virtual repository tree that mirrors the virtual module hierarchy, so that the directory path of a repository directly corresponds to the module path. It is a 'virtual' tree because the location of a repository is not hard-wired--there could be mirrors, and sub-repositories may be located on different servers if desired. A module is only stored in a separate (sub)directory from its parent module if its repository is defined as "standalone". Thus a standalone repository stores its module and all submodules whose repositories are implicit, ie. non-standalone. This to avoid having too many and very small directories and files. module a Module -- a reference to my module directory -- a directory object for the disk- or server-based directory where I store my files You must send #directory instead of accessing the instvar directly since directories are computed lazily. Modules only explitly store references to their repository if it contains unique information, others are coputed from their parent repository on demand. This saves memory but more importantly prevents repositories from getting out of phase from changes elsewhere.! Repository subclass: #FileRepository instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Modules-Repositories'! !FileRepository commentStamp: '' prior: 0! I represent a repository that is accessed via the OS file system; my directory is a FileDirectory.! ]style[(84 13 1)f1,f1LFileDirectory Comment;,f1! Repository subclass: #RemoteRepository instanceVariableNames: 'localCache ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules-Repositories'! !RemoteRepository commentStamp: '' prior: 0! I am a server-based repository that accesses files via internet protocols (HTTP, FTP), but also file:. My directory is a ServerDirectory. I also cache all my up- and downloads in a local file-based cache repository. If you only provide an FTP url, you get a pure FTP repository with full repository functionality, with read and write access, users (incl. anonymous), and all the usual stuff. If you only provide an HTTP url, you get a pure HTTP repository. This allows no users etc., and no write access (which ought to be more secure). If you provide an FTP url and an HTTP url, you get a repository that can be accessed via each of FTP and HTTP. See the class comment of ServerDirectory for more info on passwords, urls, and more.! ]style[(121 15 543 15 44)f1,f1LServerDirectory Comment;,f1,f1LServerDirectory Comment;,f1! RemoteRepository subclass: #VirtualRootRepository instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Modules-Repositories'! !VirtualRootRepository commentStamp: '' prior: 0! My sole instance represents the root of the virtual repository. The data for my sub-repositories are computed from me.! !ModuleInstaller methodsFor: 'initialize' stamp: 'hg 9/27/2001 11:53'! do: operationSymbol forModuleRef: moduleReference startModuleRef _ moduleReference. operation _ operationSymbol. self perform: operation! ! !ModuleInstaller methodsFor: 'initialize' stamp: 'hg 9/27/2001 19:36'! initialize downloadedDefs _ OrderedCollection new. loadedModules _ OrderedCollection new. createdModules _ OrderedCollection new. downloadedModules _ OrderedCollection new. loadedModules _ OrderedCollection new. ! ! !ModuleInstaller methodsFor: 'accessing' stamp: 'hg 9/26/2001 17:07'! operation ^operation! ! !ModuleInstaller methodsFor: 'accessing' stamp: 'hg 10/8/2001 21:58'! startModule ^startModuleRef module! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 10/8/2001 20:01'! allModulesNeededBy: module exceptForNeedsOf: excludedModules "Answer all modules needed by the given module, applied recursively, not considering the needs of excludedModules. This means all modules that are (indirectly) reachable from the given module. This is a basic breadth-first graph traversal algorithm." | all remaining current newRemaining neighbors excludedSet | all _ Set with: module. excludedSet _ excludedModules asSet. remaining _ all asOrderedCollection. [remaining isEmpty] whileFalse: [ current _ remaining removeFirst. neighbors _ self directlyNeededModulesFor: current. newRemaining _ (neighbors difference: excludedSet) difference: all. all addAll: neighbors. remaining addAll: newRemaining]. ^all! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 10/8/2001 23:09'! directlyNeededModulesFor: module "neighbors except start module's ref from its parent" | start | start _ self startModule. ^(self directlyReachableModulesFor: module) reject: [:neighbor | neighbor == start and: [module == start parentModule]]! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 10/9/2001 18:03'! directlyReachableModulesFor: module ^module isDeltaModule ifFalse: [module neighborModules] ifTrue: [Array with: module baseModule]! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/11/2001 22:19'! ensureAllModulesDefined "ensure that the Module objects for all involved modules are is in the image. Take ModuleReferences and ensure their definitions are loaded." self phase: 'Loading definitions for all necessary modules.' progressTotal: 0. self ensureAllReachableModulesResolved: startModuleRef. ! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/15/2001 16:13'! ensureAllReachableModulesResolved: firstModuleRef "Ensure that all recursively reachable modules are defined. This is a basic breadth-first graph traversal algorithm. Note that moduleRefs at first are unresolved, i.e. have paths instead of modules in their module slot." | all remaining currentRef newRemaining module moreRefsToScan | all _ Set with: firstModuleRef. remaining _ all asOrderedCollection. [remaining isEmpty] whileFalse: [ currentRef _ remaining removeFirst. module _ self ensureModuleResolved: currentRef. moreRefsToScan _ self refsToScanFrom: module. newRemaining _ moreRefsToScan difference: all. all addAll: moreRefsToScan. remaining addAll: newRemaining]! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/14/2001 02:42'! ensureModuleResolved: moduleRef "ensure that the Module object for the moduleRef is in the image and correctly defined. First ask the moduleRef to find a matching module for its path and version. If none, I first need to ensure that the module definition file is in the cache, then create the Module object from the definition. Return all modules that were defined--note that a composite repository may define more than one module at once. If module is created here, then assume it has a standalone repository since it must be loaded as itself, if it were part of another repository then it would have to be loaded together with it." | module modulesDefined | (moduleRef isModuleResolved not and: [moduleRef findModuleFromPathAndVersion isNil]) ifTrue: [ module _ moduleRef createModuleFromPathAndVersion. self note: 'Loading definition for module at ', module pathAndVersion printString,'.'. module repository defineFromDirectoryStructure. modulesDefined _ module repository defineModuleFromFile. "mark that modules were created" createdModules addAll: modulesDefined]. ^moduleRef module ! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/15/2001 16:32'! refsToScanFrom: module "to handle composite repositories, include refs to module at top of composite repository" | refsToScan standaloneRootModule rootRef | refsToScan _ module neighborModuleRefs. ^(module repository isImplicit and: [self willLoadModule: module]) ifTrue: [ standaloneRootModule _ module repository standaloneRepository module. rootRef _ standaloneRootModule parentModule refForNeighborModule: standaloneRootModule. refsToScan copyWith: rootRef] ifFalse: [refsToScan]! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/15/2001 16:14'! willLoadModule: module ^createdModules includes: module! ! !ModuleInstaller methodsFor: 'resolving conflicts' stamp: 'hg 10/10/2001 17:37'! identifyConflicts "match all needed modules against each other (in both directions) but not against themselves, and check them for conflicts with the other" | allModules conflicts conflictingPair | allModules _ self allModulesNeededBy: self startModule exceptForNeedsOf: #(). conflicts _ OrderedCollection new. self phase: 'Searching for conflicts between necessary modules.' progressTotal: allModules size squared. allModules _ allModules asOrderedCollection. allModules with: allModules do: [:first :second | self progressAdd: 1. (first ~= second and: [first conflictsWith: second]) ifTrue: [ conflictingPair _ (Array with: first with: second). conflicts add: conflictingPair. self note: ' ', first printString, ' marks a conflict with: ', second printString]]. conflicts isEmpty ifFalse: [ self error: 'Internal conflicts among the needed modules have been detected.'] ! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/11/2001 21:29'! ensureAllModulesInRepository "ensure that all loaded modules needing to be loaded have their necessary files in the repository." | modulesToDownload totalSize | modulesToDownload _ createdModules reject: [:mod | mod repository checkCompleteModuleContentsOK]. totalSize _ modulesToDownload inject: 0 into: [:subTotal :module | subTotal + module repository sizeOfContentsFilesToDownload]. self phase: 'Ensuring that all necessary module files are present.' progressTotal: totalSize. modulesToDownload do: [:module | self ensureModuleInRepository: module]! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/15/2001 12:53'! ensureContentsLoadedForModule: module "load in right order by ensuring that all neighbors are loaded before me. A simple depth-first strategy." ((self modulesToLoadFor: module) intersection: self modulesToLoad) do: [:neighbor | self ensureContentsLoadedForModule: neighbor]. (loadedModules includes: module) ifFalse: [ self loadContentsForModule: module] ! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 9/30/2001 19:58'! ensureModuleInCache: module | size | module repository cache checkCompleteModuleContentsOK ifFalse: [ self note: 'Downloading contents files for ', module pathAsMessages, '.'. size _ module repository sizeOfContentsFilesToDownload. module repository ensureCompleteModuleContentsInCache. self progressAdd: size. downloadedModules add: module. "record that module was downloaded" ] ! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/11/2001 21:24'! ensureModuleInRepository: module | size | module repository checkCompleteModuleContentsOK ifFalse: [ self note: 'Downloading contents files for ', module pathAsMessages, '.'. size _ module repository sizeOfContentsFilesToDownload. module repository ensureCompleteModuleContents. self progressAdd: size. downloadedModules add: module. "record that module was downloaded" ] ! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/11/2001 21:57'! initializeLoadedModules self note: 'Initializing loaded modules.'. loadedModules do: [:mod | mod allClassesDo: [:cl | (cl class includesSelector: #initialize) ifTrue: [ self note: 'Initializing class ', cl name, '.'. cl initialize]]]! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/13/2001 21:17'! loadContentsForModule: module | allLoadedModules | self note: 'Loading contents for ', module printString, ' into the image.'. allLoadedModules _ module repository loadModuleContents. self progressAdd: module repository sizeOfContentsFiles. loadedModules addAll: allLoadedModules.! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/15/2001 13:18'! modulesToLoad ^(createdModules collect: [:mod | mod repository standaloneRepository module]) asSet! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/13/2001 21:51'! modulesToLoadFor: module ^module isDeltaModule ifFalse: [module neighborModules] ifTrue: [module neighborModules copyWith: module baseModule]! ! !ModuleInstaller methodsFor: 'downloading modules' stamp: 'hg 10/15/2001 13:44'! safeLoadingOrder: modules "sort in right loading order by ensuring that all needed modules are present before a module is loaded" | sortedModules | sortedModules _ SortedCollection sortBlock: [:module1 :module2 | "can module1 be loaded before module2?" ((self allModulesNeededBy: module1 exceptForNeedsOf: #()) intersection: module2 repository compositeModules) isEmpty]. sortedModules addAll: modules. ^sortedModules ! ! !ModuleInstaller methodsFor: 'unloading' stamp: 'hg 10/8/2001 19:32'! ensureUnload | modulesToUnload modulesToDeactivate | modulesToUnload _ self modulesToUnload. modulesToDeactivate _ self modulesToDeactivate: modulesToUnload. self ensureSafeToDeactivate: modulesToDeactivate. self ensureNoUsersOf: modulesToUnload. self deactivate: modulesToDeactivate. self unload: modulesToUnload. ! ! !ModuleInstaller methodsFor: 'unloading' stamp: 'hg 10/8/2001 19:12'! modulesToUnload "should unload the given module and all its submodules" ^self deepSubmodules! ! !ModuleInstaller methodsFor: 'public' stamp: 'hg 10/11/2001 22:33'! fullyActivateModule "carry out all actions necessary to fully instate the module" self showProgressDuring: [ [[ self ensureAllModulesDefined. self identifyConflicts. self ensureAllModulesInRepository. self ensureAllModulesLoaded. self ensureAllModulesActive. self initializeLoadedModules. self done ] on: Warning do: [:ex | ex resume: true] ] on: Error do: [:ex | self revertGracefullyToStableState. self done. ] ]! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/8/2001 21:55'! ensureAllModulesActive "Ensure that all necessary modules are active. Note that this is not symmetric with ensureDeactivate, external, non-submodules may be activated." | modulesToActivate | modulesToActivate _ self allModulesNeededBy: self startModule exceptForNeedsOf: #(). self phase: 'Preparing to activate all needed modules.' progressTotal: modulesToActivate size. self switchModules: modulesToActivate beActive: true. self note: 'All the needed modules active.'. ! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/10/2001 15:11'! ensureDeactivate | modulesToDeactivate | self ensureNoUsersOf: self deepSubmodules. modulesToDeactivate _ self modulesToDeactivate. modulesToDeactivate isEmpty ifFalse: [ self phase: 'Preparing to deactivate modules.' progressTotal: modulesToDeactivate size. self switchModules: modulesToDeactivate beActive: false. self note: 'Modules now deactivated.'] ifTrue: [ self note: 'No modules to deactivate.']! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/8/2001 19:13'! modulesToDeactivate "deactivate all eligible modules in the tree of submodules" ^self modulesToDeactivate: self deepSubmodules ! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/10/2001 15:04'! modulesToDeactivate: eligibleModules "should deactivate the deltamodules of all eligible modules" | active | ^eligibleModules inject: #() into: [:deltasToDeactivate :eligibleModule | active _ (Array with: eligibleModule), eligibleModule deltaModules select: [:mod | mod isActive]. deltasToDeactivate, active]! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/8/2001 21:09'! switchModules: modules beActive: beActive "Switch the activation status of all given modules" | before after beforeAndAfter activeObjects | before _ OrderedCollection new. after _ OrderedCollection new. modules do: [:mod | self progressAdd: 1. beforeAndAfter _ mod switchActiveStatePhase1: beActive. beforeAndAfter ifNotNil: [ before addAll: beforeAndAfter first. after addAll: beforeAndAfter second]]. activeObjects _ Array with: before with: after. "the critical step:" self note: 'Switching...'. self atomicallySwitch: before to: after. modules do: [:mod | mod markAsActive: beActive]. ^activeObjects! ! !ModuleInstaller methodsFor: 'error handling' stamp: 'hg 10/12/2001 10:47'! revertGracefullyToStableState "do clever things here eventually" self revertLoadedModules. self revertActivatedModules. self revertLoadedModules. self revertDefinedModules. self notify: 'Operation failed, select Proceed to perform recovery.'. self halt.! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 9/26/2001 16:56'! atomicallySwitch: preSwitchObjects to: postSwitchObjects "Make a quick and safe atomic switch between before- and after-versions of affected objects." postSwitchObjects size = postSwitchObjects size ifFalse: [ self error: 'Different sizes of pre- and post-version arrays.']. preSwitchObjects asArray elementsExchangeIdentityWith: postSwitchObjects asArray. self class flushCache. ^true ! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/8/2001 19:35'! deepSubmodules ^startModuleRef module deepSubmodules ! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/11/2001 22:35'! done "wrap things up here"! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/8/2001 19:37'! ensureNoUsersOf: unsafeModules "safeness is defined as no other loaded modules depending on the given modules, i.e. declaring any of them as an external module." | allNeeded unsafeToUnload | allNeeded _ self allModulesNeededBy: Module root exceptForNeedsOf: unsafeModules. unsafeToUnload _ allNeeded intersection: unsafeModules. unsafeToUnload isEmpty ifFalse: [ unsafeToUnload do: [:mod | self note: 'Module ', mod pathAsMessages, ' is used by other modules.']. self error: unsafeToUnload size printString, ' modules are used by other modules.']. ! ! !ModuleInstaller methodsFor: 'user interface' stamp: 'hg 9/27/2001 19:11'! note: aMessage "notify the user. Only use transcript for now." Transcript cr; show: aMessage.! ! !ModuleInstaller methodsFor: 'user interface' stamp: 'hg 10/8/2001 21:16'! phase: phaseDescriptionString progressTotal: max Transcript show: phaseDescriptionString; cr. progressValue _ 0. "progressIndicator message: phaseDescriptionString; maxVal: max"! ! !ModuleInstaller methodsFor: 'user interface' stamp: 'hg 10/8/2001 21:16'! progressAdd: advance progressValue _ progressValue + advance. "progressIndicator value: progressValue"! ! !ModuleInstaller methodsFor: 'user interface' stamp: 'hg 9/27/2001 20:53'! showProgressDuring: aBlock "use a simple, oldstyle progress bar" progressValue _ 0. 'Starting up...' displayProgressAt: Sensor cursorPoint from: 0 to: 0 during: [:bar | progressIndicator _ bar. aBlock value]! ! !ModuleInstaller methodsFor: '(down)loading modules' stamp: 'hg 10/15/2001 13:46'! ensureAllModulesLoaded "load the contents for all modules that need to be loaded" | totalSize modulesToLoad | modulesToLoad _ self modulesToLoad. totalSize _ modulesToLoad inject: 0 into: [:subTotal :module | subTotal + module repository sizeOfContentsFiles]. self phase: 'Loading necessary modules into image.' progressTotal: totalSize. (self safeLoadingOrder: modulesToLoad) do: [:module | self loadContentsForModule: module]! ! !ModuleInstaller class methodsFor: 'instance creation' stamp: 'hg 10/11/2001 22:41'! do: selector forModule: mod ^self new do: selector forModuleRef: ((mod parentModule refForNeighborModule: mod) ifNil: [ModuleReference onPath: mod path])! ! !ModuleInstaller class methodsFor: 'instance creation' stamp: 'hg 10/8/2001 19:01'! do: selector forModuleRef: moduleReference ^self new do: selector forModuleRef: moduleReference! ! !ModuleInstaller class methodsFor: 'instance creation' stamp: 'hg 9/26/2001 16:53'! new ^super new initialize! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 10/8/2001 21:51'! activate: mod ^self do: #ensureAllModulesActive forModule: mod! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 10/8/2001 19:38'! deactivate: mod ^self do: #ensureDeactivate forModule: mod! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 10/10/2001 16:19'! fullyActivateFromPath: pathAndVersion ^self do: #fullyActivateModule forModuleRef: (ModuleReference onPath: pathAndVersion)! ! !ProgressInitiationException methodsFor: 'as yet unclassified' stamp: 'hg 9/27/2001 20:47'! maxVal: value maxVal _ value. ^self signal! ! !ProgressInitiationException methodsFor: 'as yet unclassified' stamp: 'hg 9/27/2001 20:14'! message: aString progressTitle _ aString. ^self signal! ! !Repository methodsFor: 'accessing' stamp: 'hg 9/27/2001 23:16'! directory "compute directory from my parent if not explicitly stored" ^directory ifNil: [ self parentRepository directory directoryNamed: self localName]! ! !Repository methodsFor: 'accessing' stamp: 'hg 9/21/2001 18:19'! directory: aDirectory directory _ aDirectory! ! !Repository methodsFor: 'accessing' stamp: 'hg 9/30/2001 19:46'! isTopRepository ^directory notNil! ! !Repository methodsFor: 'accessing' stamp: 'hg 9/27/2001 21:55'! localName ^self module name! ! !Repository methodsFor: 'accessing' stamp: 'hg 8/20/2001 19:05'! module ^module! ! !Repository methodsFor: 'accessing' stamp: 'hg 9/28/2001 12:27'! parentRepository ^self module parentModule doIfNotNil: [:parentMod | parentMod repository]! ! !Repository methodsFor: 'accessing' stamp: 'hg 9/30/2001 19:43'! topRepository "Answer the top repository that uses the server with my directory. (A repository subtree may be located on its own server, in which case the top of this subtree must store the directory information for this server.)" ^self isTopRepository ifTrue: [self] ifFalse: [self parentRepository topRepository]! ! !Repository methodsFor: 'accessing' stamp: 'hg 9/28/2001 12:56'! url "return the url of the location for this repository" self directory realUrl! ! !Repository methodsFor: 'initializing' stamp: 'hg 9/28/2001 12:58'! directorySpecies "class of object representing my directory" self subclassResponsibility! ! !Repository methodsFor: 'initializing' stamp: 'hg 9/27/2001 22:58'! implicitOn: aModule "set me up as an implicit (non-standalone) repository for the given module" module _ aModule. "do not make aModule refer to me, instead create me on demand" "sanity check" self isImplicit ifFalse: [ self error: 'I don''t qualify as the kind of repository I should have been']! ! !Repository methodsFor: 'initializing' stamp: 'hg 10/15/2001 16:30'! standaloneOn: aModule "set me up as a proper standalone repository for the given module" self implicitOn: aModule. self beStandalone. aModule repository: self. "sanity check" self isStandalone ifFalse: [ self error: 'I don''t qualify as the kind of repository I should have been']! ! !Repository methodsFor: 'initializing' stamp: 'hg 9/27/2001 23:18'! standaloneOn: aModule at: location "set me up as a proper standalone repository for the given module at the given location" self subclassResponsibility ! ! !Repository methodsFor: 'initializing' stamp: 'hg 8/20/2001 18:52'! subrepositorySpecies "return the default class to use as the repository for a submodule to my module." ^self class! ! !Repository methodsFor: 'file names' stamp: 'hg 9/28/2001 15:27'! moduleChangesExtension ^'chg'! ! !Repository methodsFor: 'file names' stamp: 'hg 9/28/2001 15:27'! moduleContentsExtension ^'src'! ! !Repository methodsFor: 'file names' stamp: 'hg 9/28/2001 15:26'! moduleDefinitionExtension ^'def'! ! !Repository methodsFor: 'file names' stamp: 'hg 10/2/2001 18:10'! moduleFileNameForExtension: extension "be semi-sophisticated about shortening" | str max name | str _ self module longName asString. max _ FileDirectory maxFileNameLength - self suffixLength. name _ str size > max ifFalse: [str] ifTrue: [(str first: 4), '=', (str last: max - 4 - 1)]. ^name, FileDirectory dot, extension! ! !Repository methodsFor: 'file names' stamp: 'hg 9/28/2001 15:27'! moduleImageSegmentExtension ^'seg'! ! !Repository methodsFor: 'file names' stamp: 'hg 9/30/2001 17:11'! namesOfContentsFiles ^Array with: (self moduleFileNameForExtension: self moduleContentsExtension)! ! !Repository methodsFor: 'file names' stamp: 'hg 9/28/2001 15:25'! suffixLength "delimiter plus three characters" ^4! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/10/2001 20:56'! compositeContentsOn: aStream "take various measures to ensure that necessary preconditions are met." | n | self standaloneCheck. self ensurePreconditionsForUpload. 'Uploading module ', self module pathAsMessages, ' into repository...' displayProgressAt: Sensor cursorPoint from: 0 to: self compositeModules size during: [:bar | n _ 0. aStream timeStamp; cr; cr. self compositeModules do: [:mod | bar value: (n_ n+1). mod = self module ifFalse: [ aStream cr; cr; nextChunkPut: '#nextCompositeModule'; cr; nextChunkPut: (self prefixForModule: mod); cr; cr]. mod repository contentsOn: aStream]]! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/10/2001 20:06'! compositeDefinitionsOn: aStream "Write a complete definition of all the modules in this repository, with metainformation and a timestamp." | idPrefix | aStream timeStamp; cr. aStream nextChunkPut: self metaPrerequisites; cr; cr. self compositeModules do: [:mod | idPrefix _ self prefixForModule: mod. aStream nextChunkPut: idPrefix, mod definition; cr; cr].! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/10/2001 20:47'! contentsOn: aStream "Write a complete definition of this module, with metainformation and a timestamp." | classes | aStream nextChunkPut: '"Define module variables. " '; cr; cr. self module definedNames keysAndValuesDo: [:key :value | (value isBehavior or: [value isKindOf: Module]) ifFalse: [ aStream nextChunkPut: 'self ', (self module variableDefinitionFor: key); cr; cr]]. aStream cr; nextChunkPut: '"Define classes. " '; cr; cr. classes _ OrderedCollection new. self module allClassesDo: [:class | classes add: class]. (ChangeSet superclassOrder: classes) do: [:class | aStream nextChunkPut: (self module classDefinitionFor: class); cr; cr]. "Must have chunk here to correctly avoid the comment when filing in." aStream cr; nextChunkPut: '"Define methods. " '; cr. self module fileOutMethodsOn: aStream moveSource: false toFile: 0! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/2/2001 17:40'! definitionOn: aStream "Write a complete definition of all the modules in this repository, with metainformation and a timestamp." aStream timeStamp; cr. aStream nextChunkPut: self metaPrerequisites; cr. aStream cr; nextPutAll: '"Definition for this module. "'; cr; cr. aStream nextChunkPut: 'self ', self module definition; cr.! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/10/2001 21:13'! fileIn: aStream into: topModule chunkBlock: aBlock "load a file holding code to be evaluated with module as receiver" | isCategory value targetModule | targetModule _ topModule. 'Filing in module ', topModule pathAsMessages, '...' displayProgressAt: Sensor cursorPoint from: 0 to: aStream size during: [:bar | [aStream atEnd] whileFalse: [ bar value: aStream position. aStream skipSeparators. [ isCategory _ aStream peekFor: $!!. value _ Compiler evaluate: aStream nextChunk for: targetModule logged: false. "tag indicating that new (composite) module should receive definitions, followed by expression defining the new receiver" value = #nextCompositeModule ifTrue: [ targetModule allClassesDo: [ :cl | cl removeSelectorSimply: #DoIt; removeSelectorSimply: #DoItIn:]. targetModule _ Compiler evaluate: aStream nextChunk for: topModule logged: false.] ifFalse: [ aBlock value: value value: aStream value: isCategory] ] on: Warning do: [ :ex | ex resume: true]. aStream skipStyleChunk]. aStream close]. topModule class removeSelectorSimply: #DoIt; removeSelectorSimply: #DoItIn:. ! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/1/2001 15:49'! metaPrerequisites "Answer a string that lists the prerequisites for being able to understand (i.e. load) the definition of this module. This might be a special versioning scheme, repository implementation, or even a different module implementation." | aStream list | list _ self module class metaPrerequisites, self class metaPrerequisites. list _ list asSet asSortedCollection. "remove duplicates and sort" aStream _ WriteStream on: (String new: 100). aStream nextPutAll: '"These are the meta-prerequisites for being able to understand (i.e. load) the definition of this module. "'; cr; cr; nextPutAll: "'Module hierarchyVersion: ', Module root version printString, ';'; crtab; nextPutAll: 'requiredMetaVersions:', " ' #('. list do: [:moduleRef | aStream crtab: 2; nextPutAll: moduleRef pathAndVersionDefinition]. aStream tab; nextPutAll: '). '. ^aStream contents! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/10/2001 16:40'! metaPrerequisites: list "Handle a list of the prerequisites for being able to understand (i.e. load) the definition of this module." list do: [:path | (ModuleReference onPath: path) findModuleFromPathAndVersion ifNil: [ ModuleInstaller fullyActivatePath: path]]! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/2/2001 18:49'! oldStreamNamed: onlyTheFileName "return a stream for reading from the repository" ^self standaloneRepository directory oldFileNamed: onlyTheFileName! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 9/21/2001 13:46'! streamNamed: onlyTheFileName "return a stream for writing into the repository I represent" self subclassResponsibility ! ! !Repository methodsFor: 'testing' stamp: 'hg 9/28/2001 14:24'! isImplicit "Am I an implicit repository, to be stored implicitly in my nearest standalone parent?" ^self isStandalone not! ! !Repository methodsFor: 'testing' stamp: 'hg 9/28/2001 14:29'! isStandalone "Am I a standalone repository, or should I be stored implicitly in my nearest standalone parent?" ^isStandalone = true "aLlow nil here for false"! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 9/28/2001 14:34'! beStandalone isStandalone _ true! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 10/15/2001 16:27'! compositeModules "Return those modules that should be stored in this repository." | all | self isImplicit ifTrue: [#()]. all _ OrderedCollection new. self module deepSubmodulesDo: [:mod | mod repository standaloneRepository = self module repository ifTrue: [all add: mod]. mod deltaModules do: [:delta | delta repository standaloneRepository = self module repository ifTrue: [all add: delta]]]. ^all! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 10/15/2001 12:26'! prefixForModule: mod | relativePath prefix prefixModule | self flag: #deltaModuleFor: . prefixModule _ mod isDeltaModule ifFalse: [mod] ifTrue: [mod parentModule]. relativePath _ prefixModule path allButFirst: self module path size. prefix _ 'self ', (relativePath inject: '' into: [:str :local | str, local, ' ']). ^mod isDeltaModule ifFalse: [prefix] ifTrue: [ '(', prefix, 'deltaModuleFor: ', mod baseModule path literalPrintString, ') '] ! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 10/15/2001 16:29'! standaloneCheck self isImplicit ifTrue: [ self error: 'I am not a standalone repository, but stored together with ', self standaloneRepository module printString]! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 9/27/2001 21:42'! standaloneRepository "Answer the standalone repository that I am stored in." ^self isStandalone ifTrue: [self] ifFalse: [self parentRepository standaloneRepository]! ! !Repository methodsFor: 'installer support' stamp: 'hg 10/15/2001 16:27'! checkCompleteModuleContentsOK "in future, this could be image segment OR source files" ^self isImplicit or: [ (self checkRepositoryExists and: [ self namesOfContentsFiles allSatisfy: [:name | self directory includesKey: name]]) and: [ self checkContentsFilesOK]]! ! !Repository methodsFor: 'installer support' stamp: 'hg 9/30/2001 19:53'! checkContentsFilesOK "determine strategy later" ^true! ! !Repository methodsFor: 'installer support' stamp: 'hg 9/30/2001 19:49'! checkDefinitionFileOK | name | name _ self moduleFileNameForExtension: self moduleDefinitionExtension. ^(self directory includesKey: name) and: [ true "determine verification strategy later"]! ! !Repository methodsFor: 'installer support' stamp: 'hg 9/30/2001 19:46'! checkRepositoryExists "does the repository exist that defines my module?" ^self directory exists! ! !Repository methodsFor: 'installer support' stamp: 'hg 10/14/2001 02:43'! defineFromDirectoryStructure "Define the correct status of this repository by looking on disk etc., to find out if I am standalone or not" "if I am already defined as standalone then I am ok" self isStandalone ifTrue: [^self]. "ensure that my parent is ok" self parentRepository defineFromDirectoryStructure. "perform the actual check and operation" self checkRepositoryExists ifTrue: [ Repository standaloneOn: self module]. ! ! !Repository methodsFor: 'installer support' stamp: 'hg 9/30/2001 20:01'! ensureContentsFilesOK "determine strategy later" ^self checkContentsFilesOK "..." ifFalse: [ self error: 'The module contents files are not OK for module ', module path printString]! ! !Repository methodsFor: 'installer support' stamp: 'hg 9/30/2001 19:47'! ensureDefinitionOK self checkRepositoryExists ifFalse: [ self error: 'There is no repository defined for the module ', module path printString]. self checkDefinitionFileOK ifFalse: [ self error: 'There is no module definition file in the repository for module ', module path printString]! ! !Repository methodsFor: 'installer support' stamp: 'hg 9/29/2001 18:08'! sizeOfContentsFiles ^self sizeOfFiles: self namesOfContentsFiles! ! !Repository methodsFor: 'installer support' stamp: 'hg 10/11/2001 21:19'! sizeOfContentsFilesToDownload ^self isStandalone ifFalse: [0] ifTrue: [self sizeOfFiles: self namesOfContentsFilesToDownload]! ! !Repository methodsFor: 'installer support' stamp: 'hg 10/15/2001 16:29'! sizeOfFiles: fileNames | sizes | self isImplicit ifTrue: [^0]. sizes _ self directory entries select: [:entry | fileNames includes: entry name] thenCollect: [:entry | entry fileSize]. ^sizes sum! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/11/2001 18:24'! defineModule: mod | fileName | fileName _ mod repository moduleFileNameForExtension: self moduleDefinitionExtension. self fileIn: (self oldStreamNamed: fileName) into: mod chunkBlock: [:result :stream :isCategory | (result isKindOf: Array) ifTrue: [ self metaPrerequisites: result]]. ! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/15/2001 16:28'! defineModuleFromFile self isImplicit ifTrue: [^self standaloneRepository defineModuleFromFile]. self ensureDefinitionOK. self defineModule: self module. ^self compositeModules! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 9/29/2001 14:37'! ensureDirectory ^self directory assureExistence! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 9/29/2001 14:26'! ensurePreconditionsForUpload self ensureDirectory! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/10/2001 19:31'! ensureUpload "take various measures to ensure that necessary preconditions are met." self standaloneCheck. self ensurePreconditionsForUpload. self storeModuleComposite ! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/12/2001 10:39'! importChangesFrom: aStream into: mod | deltaModule deltaClass resultWithinModule | Smalltalk newChanges: (ChangeSet basicNewNamed: 'Import Changes into ', mod pathAsMessages, ' ', Time now printString). ChangeSorter initialize. self fileIn: aStream into: mod chunkBlock: [:result :stream :isCategory | isCategory ifTrue: [ (result isKindOf: ClassCategoryReader) ifTrue: [ resultWithinModule _ mod path = (result targetClass module path first: mod path size). resultWithinModule ifFalse: [ deltaModule _ mod deltaModuleForBase: result targetClass module forceCreate: true asActive: false. deltaClass _ deltaModule deltaClassFor: result targetClass forceCreate: true. result setClass: deltaClass]]. "Class category chunk followed by method definition" result scanFrom: stream]]. mod deltaModules do: [:dm | dm fixDeltaRepresentations]. Smalltalk newChanges: (ChangeSet basicNewNamed: 'PostImport ', Time now printString). ChangeSorter initialize. ! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/13/2001 21:25'! loadModuleContents "load the files that define the contents of this module" ^self isStandalone ifFalse: [self standaloneRepository loadModuleContents] ifTrue: [self loadModuleContentsInto: self module]! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/14/2001 23:08'! loadModuleContentsInto: mod "self notify: 'Warning: You are about to load the contents of module ', mod pathAsMessages asText allBold, ' from the repository. Any unsaved contents in this module will be lost.'." Smalltalk newChanges: (ChangeSet basicNewNamed: 'Load ', mod pathAsMessages). self namesOfContentsFiles do: [:name | self fileIn: (self oldStreamNamed: name) into: mod chunkBlock: [:result :stream :isCategory | "Class category chunk followed by method definition" isCategory ifTrue: [result scanFrom: stream]]]. mod deltaModules do: [:dm | dm fixDeltaRepresentations]. Smalltalk newChanges: (ChangeSet basicNewNamed: 'PostLoading'). ChangeSorter initialize. "answer the modules that were loaded" ^self compositeModules ! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/2/2001 18:06'! storeModule: mod "store the files that define the given module" | defStream contentsStream | defStream _ self streamNamed: (mod repository moduleFileNameForExtension: self moduleDefinitionExtension). mod repository definitionOn: defStream. defStream close. contentsStream _ self streamNamed: (mod repository moduleFileNameForExtension: self moduleContentsExtension). mod repository contentsOn: contentsStream. contentsStream close.! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/2/2001 17:35'! storeModuleComposite "store the files that define this (composite) module" | defStream contentsStream | defStream _ self streamNamed: (self moduleFileNameForExtension: self moduleDefinitionExtension). self compositeDefinitionsOn: defStream. defStream close. contentsStream _ self streamNamed: (self moduleFileNameForExtension: self moduleContentsExtension). self compositeContentsOn: contentsStream. contentsStream close.! ! !FileRepository methodsFor: 'fileIn/Out' stamp: 'hg 9/27/2001 23:12'! streamNamed: onlyTheFileName "return a stream for writing into the repository I represent" ^self directory forceNewFileNamed: onlyTheFileName! ! !FileRepository methodsFor: 'accessing' stamp: 'hg 9/21/2001 18:10'! directoryClass "class of object representing my directory" ^FileDirectory! ! !FileRepository methodsFor: 'accessing' stamp: 'hg 9/21/2001 15:05'! parentRepository ^super parentRepository cache! ! !FileRepository methodsFor: 'URLs' stamp: 'hg 9/21/2001 15:32'! path ^directory ifNotNil: [directory pathName] ifNil: [super path]! ! !FileRepository methodsFor: 'URLs' stamp: 'hg 9/21/2001 15:33'! path: aString self directory: (FileDirectory on: aString)! ! !FileRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 14:14'! cacheOn: aModule directory: dir "set me up as a local cache repository for the given module" self implicitOn: aModule. self directory: dir! ! !FileRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 13:18'! directorySpecies "class of object representing my directory" ^FileDirectory! ! !FileRepository methodsFor: 'initializing' stamp: 'hg 9/27/2001 23:20'! standaloneOn: aModule at: location "set me up as a proper standalone repository for the given module at the given location" super standaloneOn: aModule. self path: location! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 13:07'! cacheSpecies ^FileRepository ! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 12:13'! directorySpecies "class of object representing my directory" ^ServerDirectory! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 16:35'! standaloneOn: aModule at: anUrl "set me up as a proper standalone repository for the given module at the given location. The kind of repository I become dependes on the URL type" self standaloneOn: aModule. self directory: (self directorySpecies new on: anUrl). self user: 'anonymous' password: nil ! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 9/30/2001 15:27'! standaloneOn: aModule ftp: ftpURL http: httpURL self standaloneOn: aModule. directory altUrl: httpURL! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 12:13'! user: userString password: password "see class comments for ServerDirectory and Password for documentation" self directory user: userString; password: password! ! !RemoteRepository methodsFor: 'fileIn/Out' stamp: 'hg 9/29/2001 14:27'! ensurePreconditionsForUpload self ensureLoggedInForWrite. super ensurePreconditionsForUpload! ! !RemoteRepository methodsFor: 'fileIn/Out' stamp: 'hg 9/29/2001 22:12'! oldStreamNamed: onlyTheFileName "return a stream for reading from the repository I represent" ^self cache directory oldFileNamed: onlyTheFileName! ! !RemoteRepository methodsFor: 'fileIn/Out' stamp: 'hg 9/29/2001 17:18'! streamNamed: onlyTheFileName "return a stream for writing into the repository I represent" ^(self directory fileNamed: onlyTheFileName) dataIsValid "shouldn't be there but I think there's a bug in RFStream"! ! !RemoteRepository methodsFor: 'URLs' stamp: 'hg 9/21/2001 14:50'! localPath "return the path to the local cache for this repository" ^self cache path! ! !RemoteRepository methodsFor: 'accessing' stamp: 'hg 9/28/2001 14:09'! cache ^localCache ifNil: [self parentRepository cacheForChild: self]! ! !RemoteRepository methodsFor: 'accessing' stamp: 'hg 9/28/2001 14:51'! cacheForChild: childRepository | childCache | childCache _ self cacheSpecies new cacheOn: childRepository module directory: (self cache directory directoryNamed: childRepository localName). childRepository isStandalone ifTrue: [childCache beStandalone]. ^childCache ! ! !RemoteRepository methodsFor: 'accessing' stamp: 'hg 10/11/2001 21:31'! sizeOfContentsFiles ^self cache sizeOfContentsFiles! ! !RemoteRepository methodsFor: 'testing' stamp: 'hg 9/28/2001 16:22'! isTypeFTP ^directory isTypeFTP! ! !RemoteRepository methodsFor: 'testing' stamp: 'hg 9/28/2001 16:22'! isTypeFile ^self directory isTypeFile! ! !RemoteRepository methodsFor: 'testing' stamp: 'hg 9/28/2001 16:22'! isTypeHTTP ^directory isTypeHTTP! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 9/30/2001 17:38'! cacheFileNamed: onlyTheFileName "load the file with the given name from my directory into the local cache" | cacheFileStream | self cache ensureDirectory. cacheFileStream _ self cache directory newFileNamed: onlyTheFileName. self directory getFileNamed: onlyTheFileName into: cacheFileStream. cacheFileStream close.! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 9/29/2001 21:45'! ensureLoggedInForWrite "ensure that my login is non-anonymous" | login | self isTypeFile ifFalse: [ self directory user = 'anonymous' ifTrue: [ login _ FillInTheBlank request: 'Login (username) for ', self directory server, ':'. login isEmpty ifTrue: [^false]. self topRepository directory user: login; password: nil; password]. ] ! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 9/29/2001 14:44'! ensureUpload "first ensure I'm uploaded into the local cache, then into the remote server" self cache ensureUpload. super ensureUpload.! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 10/13/2001 21:13'! loadModuleContentsInto: mod ^self cache loadModuleContentsInto: mod! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 10/11/2001 21:27'! checkCompleteModuleContentsOK ^self cache checkCompleteModuleContentsOK! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 10/13/2001 20:49'! checkRepositoryExists "does the repository exist that defines my module?" ^self cache checkRepositoryExists" or: [ super checkRepositoryExists and: [" "just do this to mirror remote structure in cache" "self cache ensureDirectory. true]]"! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 10/15/2001 17:01'! defineModuleFromFile self isImplicit ifTrue: [^self standaloneRepository defineModuleFromFile]. self ensureDefinitionInCache. ^self cache defineModuleFromFile. ! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 9/30/2001 17:33'! ensureCompleteModuleContentsInCache self namesOfContentsFilesToDownload do: [:name | self cacheFileNamed: name]. self cache ensureContentsFilesOK! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 9/30/2001 19:36'! ensureDefinitionFileOK | name | name _ self moduleFileNameForExtension: self moduleDefinitionExtension. self cacheFileNamed: name! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 10/11/2001 11:13'! ensureDefinitionInCache | name | (self cache checkRepositoryExists and: [self cache checkDefinitionFileOK]) ifTrue: [^self]. self ensureDefinitionOK. name _ self moduleFileNameForExtension: self moduleDefinitionExtension. self cacheFileNamed: name. ! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 9/29/2001 18:11'! namesOfContentsFilesToDownload ^self namesOfContentsFiles reject: [:name | self cache directory includesKey: name]! ! !Repository class methodsFor: 'instance creation' stamp: 'hg 9/28/2001 00:11'! implicitOn: aModule "return an implicit (non-standalone) repository for the given module" ^aModule parentModule repository subrepositorySpecies new implicitOn: aModule! ! !Repository class methodsFor: 'instance creation' stamp: 'hg 9/28/2001 00:29'! standaloneOn: aModule "return a standalone repository for the given module" ^aModule parentModule repository subrepositorySpecies new standaloneOn: aModule! ! !Repository class methodsFor: 'instance creation' stamp: 'hg 9/28/2001 00:30'! standaloneOn: aModule at: locationString "return a standalone repository for the given module at the given location" ^aModule parentModule repository subrepositorySpecies new standaloneOn: aModule at: locationString! ! !Repository class methodsFor: 'repository hierarchy' stamp: 'hg 9/10/2001 15:12'! root ^Module root repository! ! !Repository class methodsFor: 'fileIn/Out' stamp: 'hg 10/1/2001 15:27'! metaPrerequisites "Answer the prerequisites for being able to load modules from this kind of repository. A prerequisite is simply given as a ModuleReference with the adequate module and VersionSpecification. This is not final yet." ^Array with: (ModuleReference new name: nil version: self module version module: self module import: nil)! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 13:18'! defaultCacheDirectory "the default location for the root of the local repository cache, as a directory in the VM directory" ^(self cacheSpecies new directorySpecies on: Smalltalk vmPath) directoryNamed: 'RepositoryCache'! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 13:21'! defaultServer "answer the default server for the virtual repository" ^self directorySpecies serverNamed: self class defaultRepositoryName ifAbsent: [self class setupDefaultRepositoryServer]! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 14:31'! initialize self standaloneOn: Module root. self directory: self defaultServer. self setCache! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 9/28/2001 14:33'! setCache localCache _ self cacheSpecies new cacheOn: self module directory: self defaultCacheDirectory; beStandalone! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 8/20/2001 18:57'! subrepositorySpecies "return the default class to use as the repository for a submodule to my module." ^self class superclass! ! !VirtualRootRepository class methodsFor: 'instance creation' stamp: 'hg 9/28/2001 12:21'! new self error: 'There should only be one instance of me.'! ! !VirtualRootRepository class methodsFor: 'class initialization' stamp: 'hg 9/28/2001 13:33'! initialize "set up a repository for the virtual root module" "self initialize" self setupDefaultRepositoryServer. super new initialize! ! !VirtualRootRepository class methodsFor: 'default repository locations' stamp: 'hg 9/29/2001 20:48'! defaultRepositoryAltURL "URL for http access" ^'http://modules.squeakfoundation.org/VirtualRoot'! ! !VirtualRootRepository class methodsFor: 'default repository locations' stamp: 'hg 9/21/2001 19:14'! defaultRepositoryName "Central server for the virtual module repository" ^'Main Squeak Virtual Repository'! ! !VirtualRootRepository class methodsFor: 'default repository locations' stamp: 'hg 9/29/2001 21:03'! defaultRepositoryURL "URL for FTP access (this allows for password protection, for reading etc." ^'ftp://ftp2.theinternetone.net//html/VirtualRoot'! ! !VirtualRootRepository class methodsFor: 'default repository locations' stamp: 'hg 9/30/2001 15:30'! setupDefaultRepositoryServer "self setupDefaultRepositoryServer" | directory | directory _ self basicNew directorySpecies on: self defaultRepositoryURL. directory user: 'anonymous'; password: 'anonymousSqueaker'; groupName: self virtualRepositoryGroup; altUrl: self defaultRepositoryAltURL. ServerDirectory addServer: directory named: self defaultRepositoryName. ^directory! ! !VirtualRootRepository class methodsFor: 'default repository locations' stamp: 'hg 9/21/2001 18:58'! virtualRepositoryGroup "a string identifying the virtual repository server (and eventual mirrors)" ^'Squeak Virtual Repository Servers'! ! VirtualRootRepository initialize! !VirtualRootRepository class reorganize! ('instance creation' new) ('class initialization' initialize) ('default repository locations' defaultRepositoryAltURL defaultRepositoryName defaultRepositoryURL setupDefaultRepositoryServer virtualRepositoryGroup) ! Repository removeSelector: #buildStructureFromDirectory! Repository removeSelector: #defineModuleFromFile:! Repository removeSelector: #fileIn:into:! Repository removeSelector: #isComposite! !Repository reorganize! ('accessing' directory directory: isTopRepository localName module parentRepository topRepository url) ('initializing' directorySpecies implicitOn: standaloneOn: standaloneOn:at: subrepositorySpecies) ('file names' moduleChangesExtension moduleContentsExtension moduleDefinitionExtension moduleFileNameForExtension: moduleImageSegmentExtension namesOfContentsFiles suffixLength) ('fileIn/Out' compositeContentsOn: compositeDefinitionsOn: contentsOn: definitionOn: fileIn:into:chunkBlock: metaPrerequisites metaPrerequisites: oldStreamNamed: streamNamed:) ('testing' isImplicit isStandalone) ('composite repositories' beStandalone compositeModules prefixForModule: standaloneCheck standaloneRepository) ('installer support' checkCompleteModuleContentsOK checkContentsFilesOK checkDefinitionFileOK checkRepositoryExists defineFromDirectoryStructure ensureContentsFilesOK ensureDefinitionOK sizeOfContentsFiles sizeOfContentsFilesToDownload sizeOfFiles:) ('up- and downloading' defineModule: defineModuleFromFile ensureDirectory ensurePreconditionsForUpload ensureUpload importChangesFrom:into: loadModuleContents loadModuleContentsInto: storeModule: storeModuleComposite) ! ModuleInstaller class removeSelector: #fullyActivate:! ModuleInstaller class removeSelector: #fullyActivatePath:! ModuleInstaller removeSelector: #ensureAllModulesInCache! ModuleInstaller removeSelector: #ensureAllReachableModulesDefined:! ModuleInstaller removeSelector: #ensureSafeToUnload:! ModuleInstaller removeSelector: #loadContentsForAllCreatedModules! !ModuleInstaller reorganize! ('initialize' do:forModuleRef: initialize) ('accessing' operation startModule) ('graph computation' allModulesNeededBy:exceptForNeedsOf: directlyNeededModulesFor: directlyReachableModulesFor:) ('defining modules' ensureAllModulesDefined ensureAllReachableModulesResolved: ensureModuleResolved: refsToScanFrom: willLoadModule:) ('resolving conflicts' identifyConflicts) ('downloading modules' ensureAllModulesInRepository ensureContentsLoadedForModule: ensureModuleInCache: ensureModuleInRepository: initializeLoadedModules loadContentsForModule: modulesToLoad modulesToLoadFor: safeLoadingOrder:) ('unloading' ensureUnload modulesToUnload) ('public' fullyActivateModule) ('(de)activating' ensureAllModulesActive ensureDeactivate modulesToDeactivate modulesToDeactivate: switchModules:beActive:) ('error handling' revertGracefullyToStableState) ('utilities' atomicallySwitch:to: deepSubmodules done ensureNoUsersOf:) ('user interface' note: phase:progressTotal: progressAdd: showProgressDuring:) ('(down)loading modules' ensureAllModulesLoaded) ! Smalltalk removeClassNamed: #ModuleInstallerTest!