'From Squeak3.1alpha of 28 February 2001 [latest update: #4175] on 27 June 2001 at 9:49:22 pm'! "Change Set: serverGroups Date: 26 June 2001 Author: Michael Rueger Changes the way server groups are managed. Replaces the list of servers held in every ServerDirectory with a group name. Groups are computed on demand by filtering through the list of known servers. These changes are a precondition for the external server definitions introduced in a later change set."! !DocLibrary methodsFor: 'doc pane' stamp: 'mir 6/26/2001 12:08'! docObjectAt: classAndMethod "Return a morphic object that is the documentation pane for this method. nil if none can be found. Look on both the network and the disk." | fileNames server aUrl strm local obj | methodVersions size = 0 ifTrue: [self updateMethodVersions]. "first time" fileNames _ self docNamesAt: classAndMethod. self assureCacheFolder. self haveNetwork ifTrue: [ "server _ (ServerDirectory serverInGroupNamed: group) clone." "Note: directory ends with '/updates' which needs to be '/docpane', but altUrl end one level up" server _ ServerDirectory serverInGroupNamed: group. "later try multiple servers" aUrl _ server altUrl, 'docpane/'. fileNames do: [:aVersion | strm _ HTTPSocket httpGetNoError: aUrl,aVersion args: nil accept: 'application/octet-stream'. strm class == RWBinaryOrTextStream ifTrue: [ self cache: strm as: aVersion. strm reset. obj _ strm fileInObjectAndCode asMorph. (obj valueOfProperty: #classAndMethod) = classAndMethod ifFalse: [ self inform: 'suspicious object'. obj setProperty: #classAndMethod toValue: classAndMethod]. ^ obj]. "The pasteUpMorph itself" "If file not there, error 404, just keep going"]]. local _ ServerDirectory new fullPath: DocsCachePath. "check that it is really there -- let user respecify" fileNames do: [:aVersion | (local includesKey: aVersion) ifTrue: [ strm _ local readOnlyFileNamed: aVersion. obj _ strm fileInObjectAndCode asMorph. (obj valueOfProperty: #classAndMethod) = classAndMethod ifFalse: [ self inform: 'suspicious object'. obj setProperty: #classAndMethod toValue: classAndMethod]. Transcript cr; show: 'local cache: ', aVersion. ^ obj]. "The pasteUpMorph itself" "If file not there, just keep looking"]. "Never been documented" ^ nil! ! !DocLibrary methodsFor: 'database of updates' stamp: 'mir 6/26/2001 12:07'! absorbAfter: oldVersion from: fileName "Read the .ix file and add to the methodVersions database. See class comment." | server aUrl strm newUpdate newName prevFile classAndMethod updateID key verList new | server _ ServerDirectory serverInGroupNamed: group. "later try multiple servers" aUrl _ server altUrl, 'docpane/', fileName. strm _ HTTPSocket httpGetNoError: aUrl args: nil accept: 'application/octet-stream'. strm class == RWBinaryOrTextStream ifFalse: [^ false]. (strm upTo: $ ) = 'External' ifFalse: [strm close. ^ false]. newUpdate _ Integer readFrom: strm. newUpdate = oldVersion ifTrue: [strm close. ^ false]. "already have it" strm upTo: $'. newName _ strm nextDelimited: $'. strm upTo: Character cr. prevFile _ strm upTo: Character cr. "does this report on updates just after what I know?" oldVersion = (prevFile splitInteger first) ifFalse: [ strm close. ^ prevFile]. "see earlier sucessor file" [strm atEnd] whileFalse: [ strm upTo: $'. classAndMethod _ strm nextDelimited: $'. strm next. updateID _ Integer readFrom: strm. key _ DocLibrary properStemFor: classAndMethod. verList _ methodVersions at: key ifAbsent: [#()]. (verList includes: updateID) ifFalse: [ new _ verList, (Array with: updateID with: -1 "file date seen"). methodVersions at: key put: new]]. strm close. lastUpdate _ newUpdate. lastUpdateName _ newName. ^ true! ! !FileList methodsFor: 'file list menu' stamp: 'mir 6/26/2001 12:07'! putUpdate "Put this file out as an Update on the servers." | names choice | self canDiscardEdits ifFalse: [^ self changed: #flash]. names _ ServerDirectory groupNames asSortedArray. choice _ (SelectionMenu labelList: names selections: names) startUp. choice == nil ifTrue: [^ self]. (ServerDirectory serverInGroupNamed: choice) putUpdate: (directory oldFileNamed: self fullName). self volumeListIndex: volListIndex. ! ! !FtpUrl methodsFor: 'downloading' stamp: 'mir 6/26/2001 09:47'! retrieveContents "currently assumes directories end in /, and things that don't end in / are files. Also, doesn't handle errors real well...." | server contents pathString listing auth idx fileName serverName userName password | pathString _ self pathString. pathString _ pathString copyFrom: 2 to: pathString size. "remove the leading /" pathString last = $/ ifTrue:["directory?!!" fileName _ nil. ] ifFalse:[ fileName _ pathString copyFrom: (pathString lastIndexOf: $/)+1 to: pathString size. pathString _ pathString copyFrom: 1 to: (pathString lastIndexOf: $/) - 1. ]. auth _ self authority. idx _ auth indexOf: $@. idx > 0 ifTrue:[ serverName _ (auth copyFrom: idx+1 to: auth size). userName _ (auth copyFrom: 1 to: idx-1). password _ nil. ] ifFalse:[ serverName _ auth. userName _ 'anonymous'. password _ 'SqueakUser'. ]. server _ ServerDirectory servers detect:[:s| s isTypeFTP and:[s server asLowercase = serverName asLowercase]] ifNone:[nil]. server ifNil:[ server _ ServerDirectory new. server server: serverName. ] ifNotNil:[server _ server copy reset]. server user: userName. password ifNotNil:[server password: password]. server directory: pathString. fileName == nil ifFalse:[ "a file" contents _ (server getFileNamed: fileName). server sleep. (contents respondsTo: #contents) ifTrue: [ "the file exists--return it" ^MIMEDocument contentType: (MIMEDocument guessTypeFromName: self path last) content: contents contents ] ifFalse: [ "some error" ^nil ]. ]. "a directory?" listing _ String streamContents: [ :stream | stream nextPutAll: '', self pathString, ''; cr. stream nextPutAll: '

Listing for ', self pathString, '

'; cr. stream nextPutAll: '