'From Squeak3.6beta of ''4 July 2003'' [latest update: #5331] on 7 July 2003 at 5:29:06 pm'! "Change Set: BugFixArchive-Model Date: 7 June 2003 Author: Brent Vukmer This framework provides the model for the Bug Fixes Archive Viewer. See http://minnow.cc.gatech.edu/squeak/3214 for the BugFixArchiveViewer changelog and other details about the project.."! Object subclass: #ArchivePost instanceVariableNames: 'archive sourceDocument title types qaFlags statusFlags comments authorName authorEmail dateSent text attachments postUrl uid updateStreamNumbers groupDisplayLabel ' classVariableNames: 'TagQaMap TagStatusMap TagTypeMap ' poolDictionaries: '' category: 'BugFixArchive-Model'! !ArchivePost commentStamp: 'bkv 6/4/2003 17:29' prior: 0! A local copy of a post to the Bug Fixes Archive. Currently the Bug Fixes Archive is populated by a script on the swiki.gsug.org server that parses the squeak-dev.mbox file; so for the time being, an ArchivePost class is pretty closely related to the MailMessage class. You can create an ArchivePost object from an HTTP URL that points to a raw text email file: 'http://swiki.gsug.org:8080/sqfixes/2627.txt' asUrl asArchivePost. Alternatively, you can create an ArchivePost object from a MailMessage. Here's a somewhat hackish example: ArchivePost withMailMessage: (BugFixArchiveMailClient mailMessageFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt'. If an ArchivePost seems garbled, it can attempt to re-load its information as follows: 'http://swiki.gsug.org:8080/sqfixes/2627.txt' asUrl asArchivePost reload. The parsing being done behind the scenes to convert a MailMessage object to an ArchivePost object is not yet as robust as it needs to be. Here are some example of MailMessage objects that don't get parsed correctly: 'http://swiki.gsug.org:8080/sqfixes/2823.txt' asUrl asArchivePost explore. See the BugFixArchive class for more details about how ArchivePost objects are used. Or just explore the BugFixArchive locally: BugFixArchive gsugSwikiFixesArchive loadUpdates; explore. ! Object subclass: #ArchivePostGroup instanceVariableNames: 'posts aggregatedPost ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! Object subclass: #BugFixArchive instanceVariableNames: 'loadFilterSelectors updater repository archivePosts topics archivePostGroups ' classVariableNames: 'Registry ' poolDictionaries: '' category: 'BugFixArchive-Model'! !BugFixArchive commentStamp: 'bkv 6/30/2003 11:25' prior: 0! A local cache of the Squeak community's Bug Fixes Archive. instance variables: loadFilterSelectors updater repository archivePosts topics archivePostGroups class variables: Registry! Object subclass: #BugFixArchiveHttpClient instanceVariableNames: 'archive backgroundDownloader serverUids localUids rejectedUids ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! Object subclass: #BugFixArchiveMailClient instanceVariableNames: 'archive mailDb category hashes ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! BugFixArchiveHttpClient subclass: #BugFixArchiveSwikiClient instanceVariableNames: 'uidChangesetNameMap changesetPrefix ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! Object subclass: #EmailFileRepository instanceVariableNames: 'repositoryDir serverUrls storageUrlUids ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/4/2003 16:21'! authorEmailMatches: aString "Be inclusive by default. If there is no author email, return true." ^ aString isEmptyOrNil not and: [ self authorEmail isNil or: [ aString match: self authorEmail ]]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/4/2003 16:21'! authorNameMatches: aString "Be inclusive by default. If there is no author name, return true." ^ aString isEmptyOrNil not and: [ self authorName isNil or: [ aString match: self authorName ]]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/2/2003 10:15'! authorNameOrEmailMatches: aString ^ aString isEmptyOrNil not and: [ (self authorNameMatches: aString) or: [ self authorEmailMatches: aString ]]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/4/2003 16:22'! bodyMatches: aString "Be inclusive by default. If there is no body text, return true." ^ aString isEmptyOrNil not and: [ self body isNil or: [ aString match: self body ]]! ! !ArchivePost methodsFor: 'queries' stamp: 'nk 6/28/2003 12:52'! byteSize "Answer a (somewhat low) estimate of how much space I take up" " ArchivePost allSubInstances detectSum: [ :ea | ea byteSize ] " | dataSize | dataSize _ self class instSize * 4. dataSize _ dataSize + title size. dataSize _ dataSize + types size * 4. dataSize _ dataSize + qaFlags size * 4. dataSize _ dataSize + statusFlags size * 4. dataSize _ dataSize + comments size. authorName ifNotNil: [ dataSize _ dataSize + authorName size ]. authorEmail ifNotNil: [ dataSize _ dataSize + authorEmail size ]. dataSize _ dataSize + 4. dataSize _ dataSize + text size. attachments ifNotNil: [ dataSize _ dataSize + (attachments detectSum: [ :ea | (ea isKindOf: MailMessage) ifTrue: [ ea text size ] ifFalse: [ ea size ]]) ]. dataSize _ dataSize + postUrl asString size. dataSize _ dataSize + 4. updateStreamNumbers ifNotNil: [ dataSize _ dataSize + updateStreamNumbers size * 4 ]. groupDisplayLabel ifNotNil: [ dataSize _ dataSize + groupDisplayLabel size ]. ^dataSize! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/3/2003 14:49'! isBefore: beforeDate andAfter: afterDate | beforeCheck afterCheck result | self dateSent isNil ifTrue: [ ^ false ]. beforeCheck _ beforeDate isNil or: [ self dateSent < beforeDate ]. afterCheck _ afterDate isNil or: [ self dateSent > afterDate ]. result _ beforeCheck and: [ afterCheck ]. ^ result ! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/2/2003 10:10'! monthMatches: aMonth ^ aMonth isNil not and: [ self dateSent month = aMonth]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/2/2003 10:10'! monthMatches: aMonth andYearMatches: aYear ^ (self monthMatches: aMonth) and: [ self yearMatches: aYear ]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/30/2003 18:54'! size "Bogus query for heteregenous collections" ^ 1! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/4/2003 16:22'! titleMatches: aString "Be inclusive by default. If there is no title text, return true." ^ aString isEmptyOrNil not and: [ self title isNil or: [ aString match: self title ]]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/2/2003 10:13'! titleOrBodyMatches: aString ^ (self titleMatches: aString) or: [ self bodyMatches: aString ]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/2/2003 08:16'! yearMatches: aYear ^ aYear isNil not and: [ self dateSent year == aYear ]! ! !ArchivePost methodsFor: 'qa status testing' stamp: 'bkv 6/30/2003 19:05'! hasNoStatus | strictStatusTests relaxedStatusTests | strictStatusTests _ (self isMarkedAsApproved not and: [ self isMarkedAsClosed not ]) and: [ self isMarkedAsUpdate not ]. relaxedStatusTests _ (('*approve*' match: self title) not and: [ ('*close*' match: self title) not ]) and: [ ('*update -*' match: self title) not ]. ^ strictStatusTests and: [ relaxedStatusTests ]! ! !ArchivePost methodsFor: 'qa status testing' stamp: 'bkv 6/7/2003 16:37'! isMarkedAsApproved ^ self class isMarkedAsApproved: self! ! !ArchivePost methodsFor: 'qa status testing' stamp: 'bkv 6/7/2003 16:37'! isMarkedAsClosed ^ self class isMarkedAsClosed: self! ! !ArchivePost methodsFor: 'qa status testing' stamp: 'bkv 6/7/2003 16:38'! isMarkedAsUpdate ^ self class isMarkedAsUpdate: self! ! !ArchivePost methodsFor: 'qa flags testing' stamp: 'bkv 6/2/2003 11:03'! isMarkedAsHasBeenDocumented ^ self class isMarkedAsHasBeenDocumented: self! ! !ArchivePost methodsFor: 'qa flags testing' stamp: 'bkv 6/2/2003 11:05'! isMarkedAsHasBeenReviewed ^ self class isMarkedAsHasBeenReviewed: self! ! !ArchivePost methodsFor: 'qa flags testing' stamp: 'bkv 6/2/2003 11:05'! isMarkedAsHasBeenTested ^ self class isMarkedAsHasBeenTested: self! ! !ArchivePost methodsFor: 'qa flags testing' stamp: 'bkv 6/2/2003 11:05'! isMarkedAsHasSUnitTests ^ self class isMarkedAsHasSUnitTests: self! ! !ArchivePost methodsFor: 'qa flags testing' stamp: 'bkv 6/2/2003 11:04'! isMarkedAsPassesSLint ^ self class isMarkedAsPassesSLint: self! ! !ArchivePost methodsFor: 'qa flags testing' stamp: 'bkv 6/2/2003 11:05'! isMarkedAsSmall ^ self class isMarkedAsSmall: self! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 14:48'! isAnnouncement ^self types includes: #ANN! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 14:51'! isBug ^self types includes: #BUG! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 13:44'! isBugAndFix ^self isBug and: [ self isFix ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 14:35'! isBugAndNotFix ^self isBug and: [ self isFix not ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 15:47'! isBugOnly ^(self isBug) and: [ (self types reject: [ :a | a == #BUG ]) isEmpty ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 6/2/2003 16:21'! isCanonicalType "Returns whether this post has at least one of the canonical type tags." ^ self isAnnouncement or: [ self isBug or: [ self isEnhancement or: [ self isFix or: [ self isGoodie ]]]]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 14:48'! isEnhancement ^self types includes: #ENH! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 14:51'! isFix ^self types includes: #FIX! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 14:36'! isFixAndNotBug ^self isFix and: [ self isBug not ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 5/13/2003 14:48'! isGoodie ^self types includes: #GOODIE! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:09'! addQaTag: aString (( self canonicalQaTags includes: aString ) and: [ (self qaTags includes: aString) not ]) ifTrue: [ qaFlags add: (self flagForQaTag: aString) ].! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:04'! archive ^ archive! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/18/2003 21:56'! archive: aBugFixArchive archive _ aBugFixArchive! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:05'! attachments ^ attachments ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/1/2003 15:27'! attachments: attachmentPartsOrFileNames attachments _ attachmentPartsOrFileNames! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:05'! authorEmail ^ authorEmail! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:14'! authorEmail: aString authorEmail _ aString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:05'! authorName ^ authorName! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:13'! authorName: aString authorName _ aString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 08:14'! body ^ self text! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 14:46'! comments ^ comments ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 12:01'! comments: aString comments _ aString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:15'! dateSent ^dateSent! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:15'! dateSent: aDate dateSent _ aDate! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/31/2003 15:13'! groupDisplayLabel groupDisplayLabel ifNil: [ self groupDisplayLabel: (String streamContents: [ :stream | self printGroupDisplayLabelOn: stream ]) ]. ^ groupDisplayLabel! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/31/2003 15:12'! groupDisplayLabel: aString groupDisplayLabel _ aString.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/11/2003 16:36'! postUrl ^postUrl! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/9/2003 21:33'! postUrl: aUrlOrString postUrl _ aUrlOrString asUrl. self initializeUid.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:39'! qaFlags ^ qaFlags! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:01'! qaTags ^ self qaFlags collect: [ :flag | self tagForQaFlag: flag ]! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:36'! removeQaTag: aString (( self canonicalQaTags includes: aString ) and: [ self qaTags includes: aString ]) ifTrue: [ qaFlags remove: (self flagForQaTag: aString) ].! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/27/2003 13:13'! sourceDocument "Returns the document (MIMEDocument, ChangeSet file, etc.) used to create this ArchivePost object." ^ sourceDocument! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/27/2003 13:14'! sourceDocument: someKindOfDocument "Sets the document (MIMEDocument, ChangeSet file, etc.) used to create this ArchivePost object. Exposing this setter publicly allows mischief, of course -- so don't be bad!!" sourceDocument _ someKindOfDocument.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/9/2003 11:02'! statusFlags ^ statusFlags! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/7/2003 16:41'! statusTags self statusFlags ifNil: [ ^ nil ]. ^ self statusFlags collect: [ :e | self class tagForStatusFlag: e ]! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:15'! text ^text ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:15'! text: aString text _ aString ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:12'! title ^title! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/9/2003 21:35'! title: aString title _ aString. self initializeTypes. self initializeComments. self initializeQaFlags. self initializeStatusFlags.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:32'! typeTags ^ self types collect: [ :type | self tagForType: type ]! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:32'! types ^ types! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/13/2003 14:46'! types: aCollection types _ aCollection! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/9/2003 21:33'! uid ^ uid ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 6/10/2003 08:03'! updateStreamNumbers ^ updateStreamNumbers! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:05'! canonicalQaTags ^ self class canonicalQaTags ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/7/2003 16:35'! canonicalStatusTags ^ self class canonicalStatusTags ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:05'! canonicalTypeTags ^ self class canonicalTypeTags ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 08:56'! canonicalTypes ^ self class canonicalTypes ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:43'! flagForQaTag: aString ^ self class flagForQaTag: aString! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/9/2003 11:25'! flagForStatusTag: aString ^ self class flagForStatusTag: aString! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 7/3/2003 12:33'! initialize self title ifNil: [ self title: ''. ]. self attachments: OrderedCollection new. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 11:55'! initializeComments comments _ self parseCommentsFromTitle. comments ifNil: [ comments _ '' ]. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 11:55'! initializeQaFlags qaFlags _ self parseQaFlagsFromTitle. qaFlags ifNil: [ qaFlags _ OrderedCollection new. ]. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/9/2003 11:08'! initializeStatusFlags statusFlags _ self parseStatusFlagsFromTitle. statusFlags ifNil: [ statusFlags _ OrderedCollection new. ]. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 11:55'! initializeTypes | theseTypes | types _ OrderedCollection new. theseTypes _ self parseTypeTagsFromTitle collect: [ :tag | self class getTypeForTag: tag ]. theseTypes _ theseTypes reject: [ :every | every isNil ]. types addAll: theseTypes. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/9/2003 21:34'! initializeUid postUrl ifNil: [ ^ nil ]. uid _ EmailFileRepository uidFromFileName: self postUrl path last. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/9/2003 22:03'! parseCommentsFromTitle | txt startIdx endIdx | self title ifNil: [ ^ nil ]. startIdx _ self title lastIndexOf: $(. "We require an opening paren to denote comments start." (startIdx > 0) ifTrue: [ startIdx _ startIdx + 1 ] ifFalse: [ ^ nil ]. endIdx _ self title lastIndexOf: $). "Parse at all costs!! Be a little more forgiving than the web page constructor, which requires a close paren." (endIdx > startIdx) ifTrue: [ endIdx _ endIdx - 1 ] ifFalse: [ endIdx _ self title withBlanksTrimmed size ]. ((startIdx > 0) and: [ endIdx > 0 ]) ifTrue: [ txt _ self title copyFrom: startIdx to: endIdx. txt ifNotNil: [ txt _ txt withBlanksTrimmed. ]]. ^ txt ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/10/2003 08:07'! parseFlagsFromTitleUsingTagConverterSelector: aSymbol | startIdx endIdx lastIdx tagsSourceTxt flags keepParsing | (self respondsTo: aSymbol) ifFalse: [ ^ nil ]. flags _ OrderedCollection new. self comments ifNil: [ ^ nil ]. tagsSourceTxt _ self comments withBlanksTrimmed. (((startIdx _ tagsSourceTxt indexOf: $[) > 0) and: [ (endIdx _ tagsSourceTxt indexOf: $]) > 0 ]) ifFalse: [ ^ nil ]. lastIdx _ tagsSourceTxt lastIndexOf: $[. keepParsing _ lastIdx > 0. [ keepParsing ] whileTrue: [ | tag flag | tag _ tagsSourceTxt copyFrom: startIdx to: endIdx. flag _ self perform: aSymbol withArguments: { tag. }. flag ifNil: [ ('[update -*]' match: tag) ifTrue: [ | numStart numEnd updateNumbers | flag _ self perform: aSymbol withArguments: { '[update]' }. numStart _ (tag indexOf: $-) + 1. numEnd _ endIdx - 1. [ updateNumbers _ ((tag copyFrom: numStart to: numEnd) withBlanksTrimmed findTokens: { Character space. $-. }) collect: [ :token | token asNumber ]. updateStreamNumbers _ updateNumbers. ] on: Error do: [ "Skip setting the update stream number." ]]]. flag ifNotNil: [ flags add: flag. ]. keepParsing _ startIdx < lastIdx. startIdx _ tagsSourceTxt indexOf: $[ startingAt: endIdx. endIdx _ tagsSourceTxt indexOf: $] startingAt: startIdx. ]. ^ flags ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/9/2003 11:05'! parseQaFlagsFromTitle ^ self parseFlagsFromTitleUsingTagConverterSelector: #flagForQaTag ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/9/2003 11:05'! parseStatusFlagsFromTitle ^ self parseFlagsFromTitleUsingTagConverterSelector: #flagForStatusTag: ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:36'! parseTypeTagsFromTitle | tags | tags _ OrderedCollection new. ( self title notNil and: [ (self title indexOf: $[) > 0 ] ) ifTrue: [ self canonicalTypes do: [ :symbol | | strict relaxed | relaxed _ String streamContents: [ :strm | strm nextPut: $*; nextPut: $[; nextPut: $*; nextPutAll: symbol asString; nextPut: $*; nextPut: $]; nextPut: $*; yourself. ]. strict _ self tagForType: symbol. ((relaxed match: self title asUppercase) or: [ self title beginsWith: strict ]) ifTrue: [ tags add: (self tagTypeMap keyAtValue: symbol) ]]]. ^ tags ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:59'! tagForQaFlag: aString ^ self class tagForQaFlag: aString! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:06'! tagForType: aSymbol ^ self tagTypeMap keyAtValue: aSymbol ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:06'! tagQaMap ^ self class tagQaMap! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 6/2/2003 10:06'! tagTypeMap ^ self class tagTypeMap! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 5/9/2003 18:01'! describe: string withBoldLabel: label on: stream "Copied blatantly from SMCard" stream withAttribute: (TextEmphasis bold) do: [ stream nextPutAll: label ]. stream nextPutAll: string; cr.! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 6/2/2003 10:07'! downloadFileName self postUrl ifNil: [ ^nil ]. self postUrl path isEmpty ifTrue: [ ^nil ]. ^ self postUrl path last! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 6/25/2003 13:21'! fullDescription "Return a full textual description of the package." | s tab body | s _ TextStream on: (Text new: 400). tab _ String with: Character tab. self describe: self title withBoldLabel: 'Subject:' , tab , tab on: s. self authorName isEmptyOrNil ifFalse: [s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Author:']; tab; tab. s withAttribute: (PluggableTextAttribute evalBlock: [ CommentNotePad openOn: self ]) do: [s nextPutAll: authorName ]; cr]. self dateSent isNil ifFalse: [self describe: self dateSent asString withBoldLabel: 'Date Posted: ' on: s]. self text isEmptyOrNil ifFalse: [ body _ self text ] ifTrue: [ body _ '']. self describe: body withBoldLabel: 'Comments:' , tab on: s. "It would be cool to have a list of links to comments on this post, maybe." "The downloadUrl is supplied via the right-click menu in the archivePostsList pane" ^ s contents isoToSqueak! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 6/4/2003 10:49'! printGroupDisplayLabelOn: aStream | authorLabel | authorLabel _ authorName. authorLabel isEmptyOrNil ifTrue: [ authorLabel _ authorEmail ]. authorLabel isEmptyOrNil ifTrue: [ authorLabel _ '' ]. aStream nextPut: Character space. aStream nextPut: Character space. aStream nextPut: Character space. aStream nextPut: Character space. aStream nextPutAll: authorLabel. aStream nextPut: Character space. aStream nextPut: $(. aStream nextPutAll: self dateSent asString. aStream nextPut: $). aStream nextPut: Character space. self comments isEmptyOrNil ifFalse: [ aStream nextPutAll: self comments ]. ^ aStream ! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 6/2/2003 10:07'! printOn: aStream ^ aStream nextPutAll: self title! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 6/2/2003 10:07'! printString ^ self title! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 5/31/2003 14:26'! attachmentsDirectory ^self archive attachmentDirectoryFor: self! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 5/31/2003 14:29'! fileName "Returns the local name of file from which this post was loaded." | fileName | ( self postUrl isNil or: [ self postUrl asString isEmpty ] ) ifTrue: [ ^ nil ]. fileName _ self postUrl path last. ^ fileName ! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 5/30/2003 18:06'! hasAttachments ^ self attachments isEmptyOrNil not! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 6/1/2003 15:28'! saveAttachments | fileNames | self archive ifNil: [ ^ nil ]. "If possible, store fileNames for attachments instead of the attachments themselves". fileNames _ self archive saveAttachmentsFor: self. fileNames isEmptyOrNil ifFalse: [ (fileNames size == self attachments size) ifTrue: [ self attachments: fileNames ]]. ^ fileNames! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 6/27/2003 14:49'! saveSourceDocument | fileName | self archive ifNil: [ ^ nil ]. "If possible, store fileName for source document instead of the document itself". fileName _ (self archive saveSourceDocumentFor: self) name. fileName isEmptyOrNil ifFalse: [ self sourceDocument: fileName ]. ^ fileName! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 5/31/2003 15:18'! asMailMessage "Just in case, re-get self over HTTP" ^ BugFixArchiveMailClient mailMessageFromUrl: self postUrl! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 5/31/2003 16:09'! asUrl ^ self postUrl! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 7/7/2003 17:23'! reload | freshGet | freshGet _ self archive reload: self. self archive addArchivePost: freshGet. self archive removeArchivePost: self. ! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 5/31/2003 15:02'! retrieveContents "Retrieve the MIMEDocument for this ArchivePost's URL." ^ self archive retrieveContentsFor: self ! ! !ArchivePost methodsFor: 'comparing' stamp: 'nk 6/28/2003 09:45'! = otherPost self == otherPost ifTrue: [ ^true ]. self species == otherPost species ifFalse: [ ^false ]. archive = otherPost archive ifFalse: [ ^false ]. title = otherPost title ifFalse: [ ^false ]. types = otherPost types ifFalse: [ ^false ]. qaFlags = otherPost qaFlags ifFalse: [ ^false ]. statusFlags = otherPost statusFlags ifFalse: [ ^false ]. comments = otherPost comments ifFalse: [ ^false ]. authorName = otherPost authorName ifFalse: [ ^false ]. authorEmail = otherPost authorEmail ifFalse: [ ^false ]. dateSent = otherPost dateSent ifFalse: [ ^false ]. text = otherPost text ifFalse: [ ^false ]. attachments = otherPost attachments ifFalse: [ ^false ]. postUrl = otherPost postUrl ifFalse: [ ^false ]. uid = otherPost uid ifFalse: [ ^false ]. updateStreamNumbers = otherPost updateStreamNumbers ifFalse: [ ^false ]. groupDisplayLabel = otherPost groupDisplayLabel ifFalse: [ ^false ]. ^true! ! !ArchivePost methodsFor: 'comparing' stamp: 'nk 6/28/2003 09:48'! hash | hash | hash _ self species hash. hash _ hash bitXor: archive hash. hash _ hash bitXor: title hash. hash _ hash bitXor: types hash. hash _ hash bitXor: qaFlags hash. hash _ hash bitXor: statusFlags hash. hash _ hash bitXor: comments hash. hash _ hash bitXor: authorName hash. hash _ hash bitXor: authorEmail hash. hash _ hash bitXor: dateSent hash. hash _ hash bitXor: text hash. hash _ hash bitXor: attachments hash. hash _ hash bitXor: postUrl hash. hash _ hash bitXor: uid hash. hash _ hash bitXor: updateStreamNumbers hash. hash _ hash bitXor: groupDisplayLabel hash. ^hash! ! !ArchivePost class methodsFor: 'instance creation' stamp: 'bkv 6/2/2003 17:00'! new ^ super new initialize! ! !ArchivePost class methodsFor: 'instance creation' stamp: 'bkv 6/2/2003 17:42'! withMailMessage: aMailMessage "ArchivePost withMailMessage: (BugFixArchiveMailClient mailMessageFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt')" ^ BugFixArchiveMailClient archivePostFromMailMessage: aMailMessage! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:31'! canonicalQaTags ^ self tagQaMap keys! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/7/2003 16:31'! canonicalStatusTags ^ self tagStatusMap keys! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:32'! canonicalTypeTags ^ self tagTypeMap keys! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 5/16/2003 16:45'! canonicalTypes ^self tagTypeMap values! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:43'! flagForQaTag: aString ^ self tagQaMap at: aString ifAbsent: [ nil ]! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/7/2003 16:33'! flagForStatusTag: aString ^ self tagStatusMap at: aString ifAbsent: [ ^ nil ]! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 5/11/2003 18:53'! getTypeForTag: aString ^self tagTypeMap at: aString ifAbsent: [ nil ] ! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/2/2003 12:58'! tagForQaFlag: aStringOrSymbol ^ self tagQaMap keyAtValue: aStringOrSymbol asSymbol ! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/7/2003 16:32'! tagForStatusFlag: aStringOrSymbol ^ self tagStatusMap keyAtValue: aStringOrSymbol asSymbol ! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/2/2003 08:55'! tagQaMap TagQaMap isNil ifTrue: [ ^ self initializeTagQaMap ]. ^ TagQaMap! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/9/2003 11:26'! tagStatusMap TagStatusMap ifNil: [ self initializeTagStatusMap ]. ^ TagStatusMap! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:32'! tagTypeMap TagTypeMap isNil ifTrue: [ self initializeTagTypeMap ]. ^ TagTypeMap! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:22'! initialize self initializeTagTypeMap. self initializeTagQaMap.! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:43'! initializeTagQaMap TagQaMap _ Dictionary new. TagQaMap at: self tagForHasBeenDocumented put: self symbolForHasBeenDocumented. TagQaMap at: self tagForHasBeenReviewed put: self symbolForHasBeenReviewed. TagQaMap at: self tagForHasBeenTested put: self symbolForHasBeenTested. TagQaMap at: self tagForPassesSLint put: self symbolForPassesSLint. TagQaMap at: self tagForIsSmall put: self symbolForIsSmall. TagQaMap at: self tagForHasSUnitTests put: self symbolForHasSUnitTests. ^ TagQaMap! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:28'! initializeTagStatusMap TagStatusMap _ Dictionary new. TagStatusMap at: self tagForHasBeenClosed put: self symbolForHasBeenClosed. TagStatusMap at: self tagForHasBeenApproved put: self symbolForHasBeenApproved. TagStatusMap at: self tagForHasBecomeAnUpdate put: self symbolForHasBecomeAnUpdate. ^ TagStatusMap! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 5/11/2003 18:51'! initializeTagTypeMap TagTypeMap _ Dictionary new. TagTypeMap at: '[ANN]' put: #ANN. TagTypeMap at: '[BUG]' put: #BUG. TagTypeMap at: '[ENH]' put: #ENH. TagTypeMap at: '[FIX]' put: #FIX. TagTypeMap at: '[GOODIE]' put: #GOODIE. ^TagTypeMap! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:26'! symbolForHasBecomeAnUpdate ^ #hasBecomeAnUpdate ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:26'! symbolForHasBeenApproved ^ #hasBeenApproved ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:26'! symbolForHasBeenClosed ^ #hasBeenClosed ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:39'! symbolForHasBeenDocumented ^ #hasBeenDocumented ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:39'! symbolForHasBeenReviewed ^ #hasBeenReviewed ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:40'! symbolForHasBeenTested ^ #hasBeenTested ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:41'! symbolForHasSUnitTests ^ #hasSUnitTests ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:40'! symbolForIsSmall ^ #isSmall ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:40'! symbolForPassesSLint ^ #passesSLint ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:25'! tagForHasBecomeAnUpdate ^ '[update]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:24'! tagForHasBeenApproved ^ '[approved]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/7/2003 16:24'! tagForHasBeenClosed ^ '[closed]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:24'! tagForHasBeenDocumented ^ '[cd]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:24'! tagForHasBeenReviewed ^ '[er]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:24'! tagForHasBeenTested ^ '[et]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:24'! tagForHasSUnitTests ^ '[su]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:25'! tagForIsSmall ^ '[sm]' ! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 6/2/2003 11:25'! tagForPassesSLint ^ '[sl]' ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/2/2003 12:54'! harvestingTagSpecs "ArchivePost harvestingTagSpecs" ^ { { 'Documented'. self symbolForHasBeenDocumented. 'Changes have been documented; reasoning is given that explains every change made.' }. { 'Reviewed'. self symbolForHasBeenReviewed. 'Externally reviewed, design + code, by someone quite knowledgeable about the package, other than the author.' }. { 'Tested'. self symbolForHasBeenTested. 'Externally tested; including at minimum: import into a fresh image; generally making sure it does not break anything that uses it; run relevant existing SUnit tests.' }. { 'SLint-Approved'. self symbolForPassesSLint. 'SLint approved. You do not have to do what SLint says -- sometimes it is wrong -- but have a good reason why not.' }. { 'Small'. self symbolForIsSmall. 'Small changeset (10KB or less).' }. { 'SUnit'. self symbolForHasSUnitTests. 'SUnit tests have been created for this code.' }. } ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:16'! isMarkedAsApproved: anArchivePost anArchivePost statusFlags ifNil: [ ^ false ]. ^ anArchivePost statusFlags includes: self symbolForHasBeenApproved ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:16'! isMarkedAsClosed: anArchivePost anArchivePost statusFlags ifNil: [ ^ false ]. ^ anArchivePost statusFlags includes: self symbolForHasBeenClosed ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:17'! isMarkedAsHasBeenDocumented: anArchivePost anArchivePost qaFlags ifNil: [ ^ false ]. ^ anArchivePost qaFlags includes: self symbolForHasBeenDocumented ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:17'! isMarkedAsHasBeenReviewed: anArchivePost anArchivePost qaFlags ifNil: [ ^ false ]. ^ anArchivePost qaFlags includes: self symbolForHasBeenReviewed ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:17'! isMarkedAsHasBeenTested: anArchivePost anArchivePost qaFlags ifNil: [ ^ false ]. ^ anArchivePost qaFlags includes: self symbolForHasBeenTested ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:17'! isMarkedAsHasSUnitTests: anArchivePost anArchivePost qaFlags ifNil: [ ^ false ]. ^ anArchivePost qaFlags includes: self symbolForHasSUnitTests ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:17'! isMarkedAsPassesSLint: anArchivePost anArchivePost qaFlags ifNil: [ ^ false ]. ^ anArchivePost qaFlags includes: self symbolForPassesSLint ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:18'! isMarkedAsSmall: anArchivePost anArchivePost qaFlags ifNil: [ ^ false ]. ^ anArchivePost qaFlags includes: self symbolForIsSmall! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 6/9/2003 11:17'! isMarkedAsUpdate: anArchivePost anArchivePost statusFlags ifNil: [ ^ false ]. ^ anArchivePost statusFlags includes: self symbolForHasBecomeAnUpdate ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 6/2/2003 17:15'! initialize posts _ SortedCollection sortBlock: [ :a :b | a dateSent < b dateSent ]. ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 6/2/2003 08:10'! printTopicOn: aStream | content | self firstPost ifNil: [ aStream nextPutAll: ''. ^ aStream ]. content _ self topicContentFrom: self firstPost title. aStream nextPutAll: content. aStream nextPut: Character space. aStream nextPut: $(. aStream nextPutAll: self firstPost dateSent asString. aStream nextPut: $). ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 5/26/2003 09:03'! topicContentFrom: aString ^ self class topicContentFrom: aString ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 6/4/2003 07:48'! topicContentMatchesPost: anArchivePost self firstPost ifNil: [ ^ true ]. ^ (self topicContentFrom: self firstPost title) = (self topicContentFrom: anArchivePost title)! ! !ArchivePostGroup methodsFor: 'modifying' stamp: 'nk 6/28/2003 13:52'! addPost: anArchivePost "Not sure about raising an error here. For now just do nothing if anArchivePost's title doesn't match this group's topic." | groupDisplayLabel | (self topicContentMatchesPost: anArchivePost) ifFalse: [^ nil]. (posts includes: anArchivePost) ifTrue: [^ nil]. posts add: anArchivePost. groupDisplayLabel _ String streamContents: [:stream | anArchivePost printGroupDisplayLabelOn: stream]. anArchivePost groupDisplayLabel: groupDisplayLabel. self updateAggregatedPost! ! !ArchivePostGroup methodsFor: 'modifying' stamp: 'bkv 6/3/2003 23:18'! firstPost: anArchivePost "If the topic is already set, don't set a first post that doesn't match the topic." posts notEmpty ifTrue: [ ^ nil ]. self addPost: anArchivePost. ! ! !ArchivePostGroup methodsFor: 'modifying' stamp: 'bkv 6/4/2003 17:25'! removePost: anArchivePost "Not sure about raising an error here. For now just do nothing if anArchivePost's title doesn't match this group's topic." posts remove: anArchivePost ifAbsent: []. self updateAggregatedPost. ! ! !ArchivePostGroup methodsFor: 'modifying' stamp: 'bkv 6/25/2003 13:21'! updateAggregatedPost self firstPost ifNil: [ ^ nil ]. aggregatedPost ifNil: [ aggregatedPost _ ArchivePost new. ]. aggregatedPost title: self firstPost title. aggregatedPost groupDisplayLabel: (String streamContents: [ :stream | self printGroupDisplayLabelOn: stream ]). posts do: [ :post | post qaTags do: [ :qaTag | aggregatedPost addQaTag: qaTag ]]. aggregatedPost text: (String streamContents: [ :textStream | textStream nextPutAll: 'This topic has ', posts size asString, ' posts.'. textStream nextPut: Character cr. ]). aggregatedPost initialize. ! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 6/1/2003 18:16'! aggregatedPost "Return an ArchivePost object that aggregates the body-text from all of the posts in this group." ^ aggregatedPost! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 6/2/2003 16:54'! aggregatedQaTags "Returns the list of QA tags from all of the posts in this group." aggregatedPost ifNil: [ ^ #() ]. ^ aggregatedPost qaTags! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 6/2/2003 16:16'! allPosts "Return a list of all the posts in this group, with a rollup post at the head of the list." | daPosts | daPosts _ OrderedCollection new. (self firstPost notNil) ifTrue: [ daPosts add: self aggregatedPost. daPosts addAll: self posts. ]. ^ daPosts! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 6/3/2003 22:28'! archive self firstPost ifNil: [ ^ nil ]. ^ self firstPost archive! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 6/2/2003 14:36'! firstPost posts isEmptyOrNil ifTrue: [ ^ nil ]. ^ posts first! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 6/2/2003 16:16'! posts ^ posts! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 6/2/2003 08:04'! topic ^ String streamContents: [ :stream | self printTopicOn: stream ].! ! !ArchivePostGroup methodsFor: 'printing' stamp: 'bkv 6/1/2003 16:25'! printGroupDisplayLabelOn: aStream "Returns the label for the aggregatedPost that heads up the group display list" aStream nextPutAll: self topic. ^ aStream ! ! !ArchivePostGroup methodsFor: 'printing' stamp: 'bkv 6/2/2003 15:01'! printOn: aStream ^ aStream nextPutAll: self topic! ! !ArchivePostGroup methodsFor: 'printing' stamp: 'bkv 5/29/2003 22:51'! printRepliesTextOn: aStream self replies do: [ :replyPost | aStream nextPutAll: replyPost text; nextPut: Character cr; nextPutAll: '-------------------'; nextPut: Character cr; yourself ]. ! ! !ArchivePostGroup methodsFor: 'printing' stamp: 'bkv 6/2/2003 15:01'! printString ^ self topic! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/4/2003 15:42'! authorEmailMatches: aString ^ (posts select: [ :any | any authorEmailMatches: aString ]) notEmpty! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/4/2003 15:41'! authorNameMatches: aString ^ (posts select: [ :any | any authorNameMatches: aString ]) notEmpty! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:41'! authorNameOrEmailMatches: aString ^ (posts select: [ :any | any authorNameOrEmailMatches: aString ]) notEmpty! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:30'! hasReviews ^ self numberOfReviews > 1 ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:50'! isBefore: beforeDate andAfter: afterDate posts isEmptyOrNil ifTrue: [ ^ false ]. ^ (posts select: [ :post | post isBefore: beforeDate andAfter: afterDate ]) size == posts size! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:34'! leastRecentDate | leastRecentPost | leastRecentPost _ self leastRecentPost. leastRecentPost ifNil: [ ^ nil ]. ^ leastRecentPost dateSent ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:33'! leastRecentPost posts isEmptyOrNil ifTrue: [ ^ nil ]. ^ posts first! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/8/2003 14:29'! maxUid self posts isEmptyOrNil ifTrue: [ ^ nil ]. ^ (self posts asSortedCollection: [ :a :b | a uid > b uid ]) first uid ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:32'! mostRecentDate | mostRecentPost | mostRecentPost _ self mostRecentPost. mostRecentPost ifNil: [ ^ nil ]. ^ mostRecentPost dateSent ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/2/2003 14:59'! mostRecentPost posts isEmptyOrNil ifTrue: [ ^ nil ]. ^ posts last! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:37'! numberOfReviews "Returns a guess at the number of reviews. This may not be accurate if the local BugFixArchive has not loaded some posts that belong in this group. That is, the first post in a group may have been posted to the archive in 2001 but the local BugFixArchive has only loaded posts from 2003. In such a case, this number will be inaccurate. The mostRecentDate and leastRecentDate methods are helpful sanity checks." posts isEmptyOrNil ifTrue: [ ^ 0 ]. ^ posts size - 1 ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:35'! postDates posts ifNil: [ ^ nil ]. ^ posts collect: [ :post | post dateSent ] ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 22:13'! size posts isNil ifTrue: [ ^ nil ]. ^ posts size ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 22:14'! sizeMatches: aNumber "Returns whether this group meets the minimum size requirement." posts ifNil: [ ^ false ]. ^ self size >= aNumber ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:42'! titleOrBodyMatches: aString ^ (posts select: [ :any | any titleOrBodyMatches: aString ]) notEmpty! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:42'! yearMatches: aString ^ (posts select: [ :any | any yearMatches: aString ]) notEmpty! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:56'! isAnnouncement ^ self firstPost notNil and: [ self firstPost isAnnouncement ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:55'! isBug ^ self firstPost notNil and: [ self firstPost isBug ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:57'! isBugAndFix ^ self isBug and: [ self isFix ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:57'! isBugAndNotFix ^self isBug and: [ self isFix not ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:58'! isBugOnly ^ self firstPost notNil and: [ self firstPost isBugOnly ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:56'! isEnhancement ^ self firstPost notNil and: [ self firstPost isEnhancement ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:55'! isFix ^ self firstPost notNil and: [ self firstPost isFix ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:58'! isFixAndNotBug ^self isFix and: [ self isBug not ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:56'! isGoodie ^ self firstPost notNil and: [ self firstPost isGoodie ]! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/30/2003 19:06'! hasNoStatus | slackers | slackers _ self posts select: [ :post | post hasNoStatus ]. ^ slackers size == self size ! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/9/2003 22:57'! isMarkedAsApproved self firstPost ifNil: [ ^ false ]. ^ (self posts select: [ :any | any isMarkedAsApproved ]) notEmpty! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/9/2003 22:58'! isMarkedAsClosed self firstPost ifNil: [ ^ false ]. ^ (self posts select: [ :any | any isMarkedAsClosed ]) notEmpty! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/9/2003 22:58'! isMarkedAsUpdate self firstPost ifNil: [ ^ false ]. ^ (self posts select: [ :any | any isMarkedAsUpdate ]) notEmpty! ! !ArchivePostGroup class methodsFor: 'instance creation' stamp: 'bkv 6/2/2003 14:35'! withFirstPost: anArchivePost ^ self new initialize firstPost: anArchivePost; yourself! ! !ArchivePostGroup class methodsFor: 'utilities' stamp: 'bkv 6/2/2003 17:53'! topicContentFrom: aString | content parenIndex | ((parenIndex _ aString indexOf: $() > 0) ifTrue: [ content _ aString copyFrom: 1 to: (parenIndex - 1) ] ifFalse: [ content _ aString ]. ^ content withBlanksTrimmed! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 6/3/2003 15:00'! archivePostGroups "Returns this BugFixArchive's list of ArchivePosts, grouped by topic." ^ archivePostGroups ! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 6/3/2003 15:00'! archivePosts ^ archivePosts ! ! !BugFixArchive methodsFor: 'accessing' stamp: 'nk 6/28/2003 08:53'! httpClient: anHttpClient anHttpClient isHttpClient ifFalse: [ self error: 'I don''t have a very good feeling about this.' ]. updater _ anHttpClient.! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 6/3/2003 21:36'! loadFilterSelectors ^ loadFilterSelectors! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 6/3/2003 21:36'! loadFilterSelectors: aListOfSymbols loadFilterSelectors _ aListOfSymbols! ! !BugFixArchive methodsFor: 'accessing' stamp: 'nk 6/28/2003 08:53'! mailClient: aMailClient aMailClient isMailClient ifFalse: [ self error: 'I don''t have a very good feeling about this.' ]. updater _ aMailClient.! ! !BugFixArchive methodsFor: 'accessing' stamp: 'nk 6/28/2003 13:21'! name ^(self class registry keyForIdentity: self) ifNil: [ 'unnamed' ]! ! !BugFixArchive methodsFor: 'accessing' stamp: 'nk 6/28/2003 13:23'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self name; nextPut: $).! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/29/2003 22:15'! repository ^ repository! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/29/2003 22:17'! repository: aRepository self repository ifNotNil: [ self error: 'This archive already has a repository.' ]. repository _ aRepository.! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 6/3/2003 23:04'! topics ^ topics ! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 6/30/2003 14:39'! updateUrls self updater ifNil: [ ^ nil ]. ^ self updater updateUrls! ! !BugFixArchive methodsFor: 'accessing' stamp: 'nk 6/28/2003 08:54'! updater ^updater! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/28/2003 21:36'! announcementPosts ^ self archivePosts select: [ :post | post isAnnouncement ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/9/2003 13:00'! approvedArchivePostGroups self archivePostGroups ifNil: [ ^ nil ]. ^ (self archivePostGroups select: [ :every | every isMarkedAsApproved ]) ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/9/2003 18:59'! archivePostsSortedByDate "Archive posts grouped by topic and then sorted in descending order by date." ^ self archivePosts asSortedCollection: [ :a :b | a dateSent > b dateSent ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/28/2003 21:37'! bugPosts ^ self archivePosts select: [ :post | post isBug ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/9/2003 12:59'! closedArchivePostGroups self archivePostGroups ifNil: [ ^ nil ]. ^ (self archivePostGroups select: [ :every | every isMarkedAsClosed ]) ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/28/2003 21:37'! enhancementPosts ^ self archivePosts select: [ :post | post isEnhancement ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/28/2003 21:37'! fixPosts ^ self archivePosts select: [ :post | post isFix ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/28/2003 21:37'! goodiePosts ^ self archivePosts select: [ :post | post isGoodie ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/7/2003 16:49'! openArchivePostGroups | closed | closed _ self closedArchivePostGroups. self archivePostGroups ifNil: [ ^ nil ]. ^ self archivePostGroups reject: [ :any | closed includes: any ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:11'! postsForMonth: aMonth "This assumes a generic Month object ( which in Squeak, specifies the year as well )." ^ self archivePosts select: [ :post | post monthMatches: aMonth ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:12'! postsForMonth: aMonth andYear: aNumber ^ self archivePosts select: [ :post | post monthMatches: aMonth andYearMatches: aNumber ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:11'! postsForYear: aNumber ^ self archivePosts select: [ :post | post yearMatches: aNumber ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:14'! postsWithAuthorEmail: aString ^ self archivePosts select: [ :post | post authorEmailMatches: aString ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:14'! postsWithAuthorName: aString ^ self archivePosts select: [ :post | post authorNameMatches: aString ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:16'! postsWithAuthorNameOrEmail: aString ^ self archivePosts select: [ :post | post authorNameOrEmailMatches: aString ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:13'! postsWithBodyMatching: aString ^ self archivePosts select: [ :post | post bodyMatches: aString ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:13'! postsWithTitleMatching: aString ^ self archivePosts select: [ :post | post titleMatches: aString ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/2/2003 10:14'! postsWithTitleOrBodyMatching: aString ^ self archivePosts select: [ :post | post titleOrBodyMatches: aString ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 6/9/2003 12:58'! updateStreamArchivePostGroups self archivePostGroups ifNil: [ ^ nil ]. ^ (self archivePostGroups select: [ :every | every isMarkedAsUpdate ]) ! ! !BugFixArchive methodsFor: 'initialization' stamp: 'nk 6/28/2003 10:24'! initialize archivePosts _ SortedCollection sortBlock: self defaultSortBlock. archivePostGroups _ SortedCollection sortBlock: [ :a :b | a maxUid > b maxUid ]. topics _ Set new. loadFilterSelectors _ self class defaultLoadFilterSelectors. ! ! !BugFixArchive methodsFor: 'modifying' stamp: 'bkv 6/30/2003 11:19'! addArchivePost: aPost | groupTopic | aPost ifNil: [ ^ nil ]. "We only archive aPost if it is a [ANN],[BUG],[ENH],[FIX] or [GOODIE] post" (aPost isCanonicalType) ifFalse: [ ^ nil ]. "Apply the load filters -- this archive may only be configured to be even stricter." (self loadFilterSelectors anySatisfy: [ :selector | aPost perform: selector ]) ifFalse: [ ^ nil ]. aPost archive: self. aPost saveSourceDocument. aPost saveAttachments. groupTopic _ ArchivePostGroup topicContentFrom: aPost title. (groupTopic isEmptyOrNil) ifFalse: [ | matchingGroup | topics add: groupTopic. (self archivePosts includes: aPost) ifFalse: [ self archivePosts add: aPost ]. self archivePostGroups do: [ :group | (group topicContentMatchesPost: aPost) ifTrue: [ matchingGroup _ group. matchingGroup addPost: aPost ]]. matchingGroup ifNil: [ self archivePostGroups add: (ArchivePostGroup withFirstPost: aPost) ]]. ^ aPost ! ! !BugFixArchive methodsFor: 'modifying' stamp: 'bkv 6/3/2003 23:10'! rebuildGroups topics _ topics asSet. archivePostGroups _ OrderedCollection new. self topics do: [ :groupTopic | | posts group | posts _ self archivePosts select: [ :post | (ArchivePostGroup topicContentFrom: post title) withBlanksTrimmed = groupTopic withBlanksTrimmed ]. group _ ArchivePostGroup new initialize. posts do: [ :post | group addPost: post ]. archivePostGroups add: group ]. ! ! !BugFixArchive methodsFor: 'modifying' stamp: 'bkv 6/3/2003 15:01'! removeArchivePost: aPost archivePosts remove: aPost. archivePostGroups do: [ :group | group removePost: aPost ]. ! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/31/2003 14:25'! attachmentDirectoryFor: anArchivePost self repository ifNil: [ ^ nil ]. ^ self repository attachmentDirectoryFor: anArchivePost! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/30/2003 00:50'! attachmentsFor: anArchivePost ^ self repository attachmentsFor: anArchivePost! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/28/2003 08:59'! monthsRepresentedForYear: aNumber ^((self postsForYear: aNumber) collect: [ :ea | ea dateSent month ]) asSet asSortedCollection! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 7/7/2003 17:22'! reload: anArchivePost "Return fresh version of the post, re-loaded from the source document by the updater." ^ self updater reload: anArchivePost ! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/31/2003 14:56'! retrieveContentsFor: anArchivePost | mimeDoc | self repository ifNotNil: [ mimeDoc _ self repository retrieveContentsFor: anArchivePost ]. mimeDoc ifNil: [ mimeDoc _ self updater retrieveContentsFor: anArchivePost ]. ^ mimeDoc! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/29/2003 22:25'! saveAttachmentsFor: anArchivePost self repository ifNil: [ ^ nil ]. ^ self repository saveAttachmentsFor: anArchivePost! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 6/27/2003 13:37'! saveSourceDocumentFor: anArchivePost self repository ifNil: [ ^ nil ]. ^ self repository saveSourceDocumentFor: anArchivePost! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/28/2003 08:59'! yearsRepresented "Return descending sort of the set of years spanned by this archive's posts." ^ ((self archivePosts) collect: [ :ea | ea dateSent year ]) asSet asSortedCollection: [ :a :b | a > b ]! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:21'! archivePostsSortedByUid "Archive posts grouped by topic and then sorted in descending order by UID." ^ self archivePosts asSortedCollection: [ :a :b | a uid > b uid ]! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:22'! dateAscendingSortBlock ^[ :a :b | a dateSent < b dateSent ] copy fixTemps! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:22'! dateDescendingSortBlock ^[ :a :b | a dateSent > b dateSent ] copy fixTemps! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:23'! defaultSortBlock ^self uidDescendingSortBlock! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:25'! sortByDateAscending archivePosts sortBlock: self dateAscendingSortBlock! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:26'! sortByDateDescending archivePosts sortBlock: self dateDescendingSortBlock! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:26'! sortByUidAscending archivePosts sortBlock: self uidAscendingSortBlock! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:26'! sortByUidDescending archivePosts sortBlock: self uidDescendingSortBlock! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:23'! uidAscendingSortBlock ^[ :a :b | a uid < b uid ] copy fixTemps! ! !BugFixArchive methodsFor: 'sorting' stamp: 'nk 6/28/2003 10:23'! uidDescendingSortBlock ^[ :a :b | a uid > b uid ] copy fixTemps! ! !BugFixArchive methodsFor: 'testing' stamp: 'bkv 5/30/2003 00:12'! hasAttachments ^ self attachments notNil and: [ self attachments notEmpty ]! ! !BugFixArchive methodsFor: 'testing' stamp: 'bkv 5/29/2003 23:14'! isUpdatable ^ self updater notNil and: [self isUpdatableFromHttp or: [ self isUpdatableFromMailDB ]]! ! !BugFixArchive methodsFor: 'testing' stamp: 'nk 6/28/2003 08:53'! isUpdatableFromHttp ^ self updater notNil and: [ self updater isHttpClient ]! ! !BugFixArchive methodsFor: 'testing' stamp: 'nk 6/28/2003 08:54'! isUpdatableFromMailDB ^ self updater notNil and: [ self updater isMailClient ]! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/4/2003 17:45'! archivePostFromUrl: aUrlOrString self isUpdatableFromHttp ifFalse: [ self error: 'This BugFixArchive is not configured to update via HTTP.' ]. ^ self updater archivePostFromUrl: aUrlOrString! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/30/2003 14:49'! countMissingPostsFromUrl: aUrlOrString | missing | missing _ self missingUidsFromUrl: aUrlOrString. ^ (missing isNil) ifTrue: [ nil ] ifFalse: [ missing size ] ! ! !BugFixArchive methodsFor: 'updates' stamp: 'nk 6/28/2003 13:15'! listChanged "Notify my dependents that my contents have changed in some important way" self changed: #listChanged! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/4/2003 09:46'! loadFromUid: aUid toUid: anotherUid fromUrl: anUpdateUrl | retryUids | retryUids _ self updater loadFromUid: aUid toUid: anotherUid fromUrl: anUpdateUrl. ^ retryUids ! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/30/2003 17:07'! loadMissingPostsFromUrl: aUrlOrString | missingUids missingPosts | missingUids _ self missingUidsFromUrl: aUrlOrString. missingPosts _ OrderedCollection new. "Do one pass through the load process" (missingUids isEmptyOrNil not) ifTrue: [ missingPosts addAll: (self loadUids: missingUids fromUrl: aUrlOrString). ]. ^ missingPosts ! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/4/2003 17:10'! loadPreviousStopAfter: maxPosts | newPosts | newPosts _ self updater loadPreviousStopAfter: maxPosts. ^ newPosts ! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/30/2003 16:52'! loadTheWholeEnchilada | retryUids | self updateUrls ifNil: [ ^ nil ]. retryUids _ OrderedCollection new. self updateUrls do: [ :url | | serverUids | serverUids _ self serverUidsForUrl: url. retryUids addAll: (self loadUids: serverUids fromUrl: url). ]. ^ retryUids ! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/30/2003 12:14'! loadUids: aListOfUids fromUrl: anUpdateUrl | retryUids | self updater ifNil: [ ^ nil ]. retryUids _ self updater loadUids: aListOfUids fromUrl: anUpdateUrl. ^ retryUids ! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 5/30/2003 10:45'! loadUpdates ^ self loadUpdatesStopAfter: 0! ! !BugFixArchive methodsFor: 'updates' stamp: 'bkv 6/4/2003 17:11'! loadUpdatesStopAfter: maxUpdates | newPosts | newPosts _ self updater loadUpdatesStopAfter: maxUpdates. ^ newPosts ! ! !BugFixArchive methodsFor: 'validation' stamp: 'bkv 6/28/2003 12:49'! cleanUp self repository ifNil: [ ^ self ]. ^ self repository cleanUp. ! ! !BugFixArchive methodsFor: 'validation' stamp: 'bkv 6/27/2003 17:10'! missingUidsFromUrl: aUrlOrString "Returns the list of UIDs from a given update URL that should exist in the local set of UIDs, but don't." | absDiff rejected sortedLocals missing | absDiff _ self uidsDiffAgainstUrl: aUrlOrString. absDiff ifNil: [ absDiff _ #() ]. rejected _ self rejectedUidsForUrl: aUrlOrString. rejected ifNil: [ rejected _ #() ]. missing _ absDiff difference: rejected. sortedLocals _ (self uidsForUrl: aUrlOrString) asSortedCollection: [ :a :b | a > b ]. (sortedLocals isEmptyOrNil) ifFalse: [ missing _ missing select: [ :uid | (uid <= sortedLocals first) and: [ uid >= sortedLocals last ]]]. ^ missing! ! !BugFixArchive methodsFor: 'validation' stamp: 'bkv 6/30/2003 11:37'! rejectedUidsForUrl: aUrlOrString self updater ifNil: [ ^ nil ]. ^ self updater rejectedUidsForUrl: aUrlOrString ! ! !BugFixArchive methodsFor: 'validation' stamp: 'bkv 6/27/2003 14:53'! serverUidsForUrl: aUrlOrString "Returns the list of uids for the given updater URLs" self updater ifNil: [ ^ nil ]. ^ self updater serverUidsForUrl: aUrlOrString ! ! !BugFixArchive methodsFor: 'validation' stamp: 'bkv 6/27/2003 15:00'! uidsDiffAgainstUrl: aUrlOrString "Returns the Set-difference between the UIDs on the server for a given URL, and those stored locally for a given URL; that is, the UIDs that have *not* been loaded from the URL." | diff local server | server _ self serverUidsForUrl: aUrlOrString. local _ self uidsForUrl: aUrlOrString. "For now, treat nil UIDs collections as though they were empty. Figure out error-handling logic later..." server ifNil: [ server _ #() ]. local ifNil: [ local _ #() ]. diff _ server difference: local. ^ diff! ! !BugFixArchive methodsFor: 'validation' stamp: 'bkv 6/24/2003 22:04'! uidsForUrl: aUrlOrString | uids | self archivePosts ifNotNil: [ uids _ ((self archivePosts select: [ :every | (aUrlOrString asString, '*') match: every postUrl asString ]) collect: [ :ea | ea uid ]) select: [ :e | e notNil ]. ]. uids isEmptyOrNil ifFalse: [ uids _ uids asSortedCollection: self updater uidsSortBlock ]. ^ uids ! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'nk 6/28/2003 08:19'! defaultArchive "BugFixArchive defaultArchive" ^ self gsugSwikiArchive! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'nk 6/28/2003 08:17'! gsugSwikiArchive "BugFixArchive gsugSwikiArchive" ^self named: #gsugSwikiArchive ifAbsentPut: [ | httpClient archive | httpClient _ BugFixArchiveHttpClient gsugSwikiArchiveClient. archive _ self new initialize httpClient: httpClient. httpClient archive: archive. archive repository: EmailFileRepository gsugSwikiArchiveFileRepository. archive ]! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'nk 6/28/2003 08:18'! gsugSwikiFixesArchive "BugFixArchive gsugSwikiFixesArchive" ^self named: #gsugSwikiFixesArchive ifAbsentPut: [ | httpClient archive | httpClient _ BugFixArchiveHttpClient withUpdateUrls: { BugFixArchiveHttpClient fixesEtcUpdatesUrl. }. archive _ self new initialize httpClient: httpClient. httpClient archive: archive. archive repository: (EmailFileRepository onServerUrls: { BugFixArchiveHttpClient fixesEtcUpdatesUrl. }). archive ]! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'nk 6/28/2003 08:19'! kcpSwikiArchive "BugFixArchive kcpSwikiArchive" ^self named: #kcpSwikiArchive ifAbsentPut: [ | httpClient archive | httpClient _ BugFixArchiveHttpClient kcpSwikiArchiveClient. archive _ self new initialize httpClient: httpClient. httpClient archive: archive. archive repository: EmailFileRepository kcpSwikiArchiveFileRepository. archive ]! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'nk 6/28/2003 08:19'! new ^super new initialize! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'bkv 5/29/2003 20:43'! onMailDB: aMailDB withCategory: aCategory | mailClient archive | mailClient _ BugFixArchiveMailClient onMailDB: aMailDB withCategory: aCategory. archive _ self new initialize mailClient: mailClient. mailClient archive: archive. ^ archive ! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'bkv 5/28/2003 21:39'! withArchivePosts: aList | archive | archive _ self new. aList do: [ :post | archive addArchivePost: post ]. ^ archive! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'bkv 5/29/2003 20:43'! withUpdateUrls: aListOfUrls | httpClient archive | httpClient _ BugFixArchiveHttpClient withUpdateUrls: aListOfUrls. archive _ self new initialize httpClient: httpClient. httpClient archive: archive. ^ archive! ! !BugFixArchive class methodsFor: 'load filters' stamp: 'bkv 6/23/2003 12:51'! defaultLoadFilterSelectors ^ #( isFix isEnhancement isGoodie )! ! !BugFixArchive class methodsFor: 'registry' stamp: 'nk 6/28/2003 12:33'! clearRegistry "Initialize my registry, thus forgetting all the registered BFAs" ^Registry _ WeakValueDictionary new! ! !BugFixArchive class methodsFor: 'registry' stamp: 'nk 6/28/2003 08:45'! forgetArchiveNamed: aSymbol "Remove the BFA named aSymbol from my registry, if there is such an entry." ^self registry removeKey: aSymbol ifAbsent: []! ! !BugFixArchive class methodsFor: 'registry' stamp: 'nk 6/28/2003 08:16'! named: aSymbol ifAbsentPut: aBlock "Answer the BFA named aSymbol. If it doesn't exist, or has been garbage collected, register the value of aBlock under aSymbol and answer that." | retval | retval _ self registry at: aSymbol ifAbsentPut: [ nil ]. ^retval ifNil: [ self registry at: aSymbol put: aBlock value ]. ! ! !BugFixArchive class methodsFor: 'registry' stamp: 'nk 6/28/2003 08:49'! registry "Answer my registry, which is a Dictionary of name->BFA" ^Registry ifNil: [ self clearRegistry ].! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 6/27/2003 13:22'! addRejectedUid: aUid forUrl: aUrlOrString | urlString uids | urlString _ aUrlOrString asString. uids _ rejectedUids at: urlString ifAbsent: [ nil ]. uids ifNil: [ ^nil ]. (uids includes: aUid) ifFalse: [ uids add: aUid ]. ^ uids ! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 5/30/2003 01:07'! archive ^ archive! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 5/30/2003 01:07'! archive: aBugFixArchive archive _ aBugFixArchive! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 6/4/2003 12:56'! localUidsForUrl: aUrlOrString | urlString uids | urlString _ aUrlOrString asString. uids _ localUids at: urlString ifAbsent: [ nil ]. uids ifNil: [ ^nil ]. ^ uids ! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 6/27/2003 08:48'! rejectedUidsForUrl: aUrlOrString | urlString uids | urlString _ aUrlOrString asString. uids _ rejectedUids at: urlString ifAbsent: [ nil ]. uids ifNil: [ ^nil ]. ^ uids ! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 5/31/2003 18:03'! repository self archive ifNil: [ ^ nil ]. ^ self archive repository! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 6/3/2003 16:21'! serverUidsForUrl: aUrlOrString | urlString uids | urlString _ aUrlOrString asString. uids _ serverUids at: urlString ifAbsent: [ nil ]. uids ifNil: [ ^nil ]. ^ uids ! ! !BugFixArchiveHttpClient methodsFor: 'accessing' stamp: 'bkv 6/30/2003 14:42'! updateUrls ^ (serverUids keys collect: [ :urlString | urlString asUrl ]) asOrderedCollection! ! !BugFixArchiveHttpClient methodsFor: 'initialization' stamp: 'bkv 6/27/2003 08:48'! initialize serverUids _ Dictionary new. localUids _ Dictionary new. rejectedUids _ Dictionary new. ! ! !BugFixArchiveHttpClient methodsFor: 'initialization' stamp: 'bkv 6/24/2003 21:34'! uidsSortBlock ^ [ :a :b | a > b ] ! ! !BugFixArchiveHttpClient methodsFor: 'modifying' stamp: 'bkv 6/27/2003 08:48'! addUpdateUrl: aUrlOrString | urlString | urlString _ aUrlOrString asString. serverUids at: urlString ifAbsentPut: (SortedCollection sortBlock: self uidsSortBlock). localUids at: urlString ifAbsentPut: (SortedCollection sortBlock: self uidsSortBlock). rejectedUids at: urlString ifAbsentPut: (SortedCollection sortBlock: self uidsSortBlock). ^ self loadServerUidsFromUrl: aUrlOrString ! ! !BugFixArchiveHttpClient methodsFor: 'modifying' stamp: 'bkv 6/3/2003 15:42'! removeUpdateUrl: aUrlOrString | urlString | urlString _ aUrlOrString asString. serverUids removeKey: urlString ifAbsent: []. localUids removeKey: urlString ifAbsent: []. ! ! !BugFixArchiveHttpClient methodsFor: 'testing' stamp: 'bkv 5/28/2003 23:01'! isHttpClient ^ true! ! !BugFixArchiveHttpClient methodsFor: 'testing' stamp: 'bkv 5/28/2003 23:02'! isMailClient ^ false! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/27/2003 08:27'! archivePostFromUrl: aUrlOrString "Returns the ArchivePost loaded from the given URL." ^ self class archivePostFromUrl: aUrlOrString. ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/26/2003 21:42'! archivePostUrlFromUid: aUid forBaseUrl: aUrlOrString ^ self class archivePostUrlFromUid: aUid forBaseUrl: aUrlOrString. ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/30/2003 13:11'! asyncLoadUids: aListOfUids fromUrl: aUrlOrString | newPosts url locUids loadUids postQueue postQueueSema archivePost failures successes failedLoadUid current next | aListOfUids isEmptyOrNil ifTrue: [ ^ nil ]. newPosts _ OrderedCollection new. url _ aUrlOrString asUrl. loadUids _ aListOfUids. locUids _ self archive uidsForUrl: url. locUids isEmptyOrNil ifFalse: [ loadUids _ loadUids reject: [ :loadUid | locUids includes: loadUid ]]. loadUids isEmptyOrNil ifTrue: [ ^ nil ]. "Track the failures and successes for this set of load attempts" failures _ OrderedCollection new. successes _ OrderedCollection new. "Setup for loading asynchoronously." "--Send downloaded ArchivePosts through this queue" postQueue _ SharedQueue new. "--Use a Semaphore to keep too many ArchivePosts from being queued up at a time" postQueueSema := Semaphore new. 5 timesRepeat: [ postQueueSema signal ]. "--Fork a process to download the ArchivePosts" "Download the given list of UIDs. The queue will be loaded alternately with url's and with the retrieved contents. If a download fails, the contents will be #failed. If all goes well, a special pair with a zero UID and the contents #finished will be put on the queue. postQueueSema is waited on every time before a new document is downloaded; this keeps the downloader from getting too far ahead of the main process" "Kill the existing downloader if there is one" backgroundDownloader ifNotNil: [backgroundDownloader terminate]. "Fork a new downloading process" backgroundDownloader _ [loadUids do: [:uid | postQueueSema wait. postQueue nextPut: uid. archivePost _ self loadUid: uid fromUrl: aUrlOrString.. (archivePost isNil) ifTrue: [postQueue nextPut: #failed. backgroundDownloader _ nil. Processor activeProcess terminate] ifFalse: [backgroundDownloader ifNotNil: [ postQueue nextPut: archivePost ]]]. postQueue nextPut: 0. postQueue nextPut: #finished. backgroundDownloader _ nil] newProcess. backgroundDownloader priority: Processor systemBackgroundPriority. "start the process running in the background" backgroundDownloader resume. "Fetch downloaded ArchivePosts from the queue" [current _ postQueue next. next _ postQueue next. (next == #failed) ifTrue: [ failedLoadUid _ current. failures add: current ]. ((failedLoadUid ~= 0) and: [ next ~= #finished]) ] whileTrue: [ (failedLoadUid isNil and: [ next isSymbol not ]) ifTrue: [successes add: current. newPosts add: next]. postQueueSema signal ]. ^ newPosts ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/25/2003 14:08'! getServerUidRangeForUrl: aUrlOrString | url currentUids prevMax maxUid uids | url _ aUrlOrString asUrl. currentUids _ serverUids at: url asString ifAbsent: [ nil ]. currentUids ifNil: [ ^ nil ]. uids _ SortedCollection sortBlock: [ :a :b | a > b ]. (currentUids isEmpty) ifTrue: [ prevMax _ 1 ] ifFalse: [ prevMax _ currentUids first + 1 ]. "Grab most recent uid from server." maxUid _ self maxUidFromUrl: url. maxUid ifNil: [ maxUid _ self lastMaxUidFromUrl: url ]. maxUid ifNil: [ ^ nil ]. "Load the list of uids stored on the server. Assume a continuous list of integers." prevMax to: maxUid do: [ :uid | uids add: uid. ]. ^ uids! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/24/2003 17:39'! lastMaxUidFromUrl: aUrlOrString | srvUids | srvUids _ self serverUidsForUrl: aUrlOrString. srvUids isEmptyOrNil ifTrue: [ ^ nil ]. ^ srvUids first! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/23/2003 16:25'! leastLocalUidFromUrl: aUrlOrString "Returns the least UID that has actually been *loaded* into this client's archive." | locUids | locUids _ self archive uidsForUrl: aUrlOrString. locUids isEmptyOrNil ifTrue: [ ^ nil ]. ^ locUids last! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'nk 6/28/2003 07:37'! loadArchivePostWithUid: aUid fromUpdatesUrl: aUrlOrString | updatesUrl serverUrl fileUrl loadUrl archivePost | updatesUrl _ aUrlOrString asString. fileUrl _ self repositoryUrlFromUid: aUid forBaseUrl: updatesUrl. serverUrl _ self archivePostUrlFromUid: aUid forBaseUrl: updatesUrl. (fileUrl isNil) ifTrue: [ loadUrl _ serverUrl ] ifFalse: [ loadUrl _ fileUrl ]. archivePost _ self archivePostFromUrl: loadUrl. "Should add a preference for whether to store FileUrl or HttpUrl. Right now always use HttpUrl." archivePost postUrl: serverUrl. ^ archivePost! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/27/2003 08:16'! loadFromUid: aUid toUid: anotherUid fromUrl: aUrlOrString | url maxUid startUid endUid loadUids | (anotherUid > aUid ) ifTrue: [ startUid _ aUid. endUid _ anotherUid. ] ifFalse: [ startUid _ anotherUid. endUid _ aUid ]. url _ aUrlOrString asUrl. maxUid _ self lastMaxUidFromUrl: url. ( endUid > maxUid ) ifFalse: [ maxUid _ endUid ]. loadUids _ (self serverUidsForUrl: url) select: [ :uid | (uid >= startUid) and: [ uid <= maxUid ]]. ^ self loadUids: loadUids fromUrl: url! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/23/2003 16:13'! loadPreviousStopAfter: maxPosts | newPosts limit | newPosts _ OrderedCollection new. maxPosts isNil ifTrue: [ limit _ 500 ] ifFalse: [ limit _ maxPosts ]. ( limit < 1 ) ifTrue: [ "Assume we are initializing the archive and use a relatively large limit." limit _ 500 ]. self updateUrls do: [ :updateUrl | | startUid endUid | self loadServerUidsFromUrl: updateUrl. endUid _ self leastLocalUidFromUrl: updateUrl. (endUid isNil or: [ endUid < 1 ]) ifTrue: [ endUid _ self maxUidFromUrl: updateUrl ]. (endUid isNil or: [ endUid < 1 ]) ifFalse: [ startUid _ endUid - limit. (startUid < 1) ifTrue: [ startUid _ 1 ]. ((endUid - startUid) > 1) ifTrue: [ newPosts addAll: (self loadFromUid: startUid toUid: endUid fromUrl: updateUrl). ]]]. ^ newPosts! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/30/2003 15:29'! loadServerUidsFromUrl: aUrlOrString | url currentUids newUids | url _ aUrlOrString asUrl. currentUids _ serverUids at: url asString ifAbsent: [ nil ]. currentUids ifNil: [ ^ nil ]. [ newUids _ self getServerUidRangeForUrl: url.] on: Error do: [ "Nothing, unable to update." ]. newUids ifNil: [ ^ nil ]. currentUids addAll: (newUids difference: currentUids). ^ newUids ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/24/2003 22:11'! loadTokensForUidNumber: aNumber ^ { aNumber asString. } ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/27/2003 20:03'! loadUid: aUid fromUrl: aUrlOrString | archivePost url | aUid ifNil: [ ^ nil ]. url _ aUrlOrString asUrl. [ archivePost _ self loadArchivePostWithUid: aUid fromUpdatesUrl: url. ] on: Error do: ["Nothing right now"]. archivePost ifNotNil: [ ((self localUidsForUrl: url) includes: aUid) ifFalse: [ (self localUidsForUrl: url) add: aUid ]]. ^ archivePost ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/30/2003 14:15'! loadUids: aListOfUids fromUrl: aUrlOrString ^ self synchronousLoadUids: aListOfUids fromUrl: aUrlOrString! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 5/30/2003 10:53'! loadUpdates ^ self loadUpdatesStopAfter: 0 ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/25/2003 12:10'! loadUpdatesStopAfter: maxPosts | newPosts limit | newPosts _ OrderedCollection new. (maxPosts isNil or: [maxPosts == 0]) ifTrue: [ limit _ 500 ] ifFalse: [ limit _ maxPosts ]. self updateUrls do: [ :updateUrl | | serverMax localMax startUid endUid | self loadServerUidsFromUrl: updateUrl. serverMax _ self lastMaxUidFromUrl: updateUrl. (serverMax notNil and: [ serverMax > 0 ]) ifTrue: [ endUid _ serverMax ] ifFalse: [ endUid _ 1 ]. localMax _ self maxLocalUidFromUrl: updateUrl. (localMax isNil) ifTrue: [ ( limit < 1 ) ifTrue: [ "Assume we are meant to load the whole enchilada." startUid _ 1 ] ifFalse: [ startUid _ serverMax - limit ]] ifFalse: [ startUid _ localMax + 1 ]. (startUid < 1) ifTrue: [ startUid _ 1 ]. ((endUid - startUid) > 1) ifTrue: [ newPosts addAll: (self loadFromUid: startUid toUid: endUid fromUrl: updateUrl). ]]. ^ newPosts ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/9/2003 12:01'! maxLocalUidFromUrl: aUrlOrString | locUids | locUids _ self localUidsForUrl: aUrlOrString. locUids isEmptyOrNil ifTrue: [ ^ nil ]. ^ locUids first! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 5/31/2003 09:22'! maxUidFromUrl: aUrlOrString ^ self class maxUidFromUrl: aUrlOrString! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/28/2003 14:06'! parseUidNumberFrom: aStringOrNumber ^ self class parseUidNumberFrom: aStringOrNumber! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/24/2003 15:01'! parseUidsFromHtmlDoc: aMIMEDocument ^ self class parseUidsFromHtmlDoc: aMIMEDocument! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 7/7/2003 17:21'! reload: anArchivePost | reloadedPost | reloadedPost _ self class archivePostFromUrl: anArchivePost postUrl. reloadedPost ifNil: [ ^ nil ]. ^ reloadedPost! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/28/2003 14:06'! repositoryUrlFromUid: aUid forBaseUrl: aUrlOrString | baseUrl serverUrl fileUrl | baseUrl _ aUrlOrString asUrl. serverUrl _ self class archivePostUrlFromUid: aUid forBaseUrl: aUrlOrString. self repository ifNotNil: [ | uidNumber maxUidNumber | uidNumber _ self parseUidNumberFrom: aUid. maxUidNumber _ self repository maxUidForServerUrl: baseUrl. ( maxUidNumber < uidNumber) ifFalse: [ fileUrl _ self repository fileUrlFor: serverUrl ]]. ^ fileUrl! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 5/31/2003 16:10'! retrieveContentsFor: anArchivePost ^ anArchivePost asUrl retrieveContents! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/30/2003 13:11'! synchronousLoadUids: aListOfUids fromUrl: aUrlOrString | newPosts url locUids loadUids | aListOfUids isEmptyOrNil ifTrue: [ ^ nil ]. newPosts _ OrderedCollection new. url _ aUrlOrString asUrl. loadUids _ aListOfUids. locUids _ self archive uidsForUrl: url. locUids isEmptyOrNil ifFalse: [ loadUids _ loadUids reject: [ :loadUid | locUids includes: loadUid ]]. loadUids do: [ :loadUid | | archivePost | archivePost _ self loadUid: loadUid fromUrl: aUrlOrString. archivePost ifNotNil: [ newPosts add: archivePost. ]]. ^ newPosts ! ! !BugFixArchiveHttpClient class methodsFor: 'instance creation' stamp: 'bkv 5/27/2003 21:06'! gsugSwikiArchiveClient "BugFixArchiveHttpClient gsugSwikiArchiveClient" ^ self withUpdateUrls: { self bugUpdatesUrl. self fixesEtcUpdatesUrl. } ! ! !BugFixArchiveHttpClient class methodsFor: 'instance creation' stamp: 'bkv 6/28/2003 11:27'! gsugSwikiFixesArchiveClient "BugFixArchiveHttpClient gsugSwikiArchiveClient" ^ self withUpdateUrls: { self fixesEtcUpdatesUrl. } ! ! !BugFixArchiveHttpClient class methodsFor: 'instance creation' stamp: 'bkv 6/24/2003 13:08'! kcpSwikiArchiveClient "BugFixArchiveHttpClient kcpSwikiArchiveClient" ^ BugFixArchiveSwikiClient kcpSwikiArchiveClient ! ! !BugFixArchiveHttpClient class methodsFor: 'instance creation' stamp: 'bkv 6/1/2003 21:35'! withUpdateUrls: aListOfUrls | client | client _ self new initialize. aListOfUrls do: [ :url | client addUpdateUrl: url ]. ^ client ! ! !BugFixArchiveHttpClient class methodsFor: 'class initialization' stamp: 'bkv 5/27/2003 20:31'! bugUpdatesUrl ^ ( self gsugSwikiUrl asString, '/sqbugs' ) asUrl ! ! !BugFixArchiveHttpClient class methodsFor: 'class initialization' stamp: 'bkv 5/27/2003 20:31'! fixesEtcUpdatesUrl ^ ( self gsugSwikiUrl asString, '/sqfixes' ) asUrl ! ! !BugFixArchiveHttpClient class methodsFor: 'class initialization' stamp: 'bkv 5/27/2003 20:29'! gsugSwikiUrl ^'http://swiki.gsug.org:8080' asUrl! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/1/2003 21:41'! archivePostUrlFromUid: aUid forBaseUrl: aUrlOrString | url | url _ (aUrlOrString asString, '/', aUid asString, '.txt') asUrl. ^ url! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 12:19'! calculateUidEndInHtmlString: aString startingAt: aNumber ^ (aString findString: self uidEndHtmlDelimiter startingAt: aNumber) - 1! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 12:56'! calculateUidStartInHtmlString: aString startingAt: aNumber ^ (aString findString: self uidStartHtmlDelimiter startingAt: aNumber ) + self uidStartHtmlDelimiter size! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 11:54'! hrefPrefixIn: aString "We assume URLs structured as currently at the GSUG swiki." | hrefPrefix idx | hrefPrefix _ 'sqfixes/'. idx _ aString findString: hrefPrefix. ( idx == 0 ) ifTrue: [ hrefPrefix _ 'sqbugs/'. ]. ( idx == 0 ) ifTrue: [ hrefPrefix _ nil ]. ^ hrefPrefix! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/9/2003 11:56'! maxUidFromUrl: aUrlOrString "Parses text/plain MIMEDocuments ( '/last' ) as well as text/html MIMEDocuments ( '/sqbugs/index.html' )" | textUrl htmlUrl mimeDoc result uids | uids _ SortedCollection sortBlock: [ :a :b | a > b ]. textUrl _ (aUrlOrString asString, '/last') asUrl. htmlUrl _ (aUrlOrString asString, '/index.html') asUrl. mimeDoc _ textUrl retrieveContents. [ result _ self parseUidsFromTextDoc: mimeDoc. result ifNil: [ mimeDoc _ htmlUrl retrieveContents. result _ self parseUidsFromHtmlDoc: mimeDoc ]] on: Error do: [ "Can't retrieve max uid." ^ nil ]. result isEmptyOrNil ifTrue: [ ^ nil ]. uids addAll: result. ^ uids first! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 15:08'! parseUidFrom: aString | uid | aString isEmptyOrNil ifTrue: [ ^ nil ]. uid _ aString asInteger. ^ uid! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/25/2003 08:09'! parseUidNumberFrom: aStringOrNumber ^ aStringOrNumber isNumber ifTrue: [ aStringOrNumber ] ifFalse: [ (aStringOrNumber isEmptyOrNil) ifTrue: [ nil ] ifFalse: [ ^ aStringOrNumber asNumber ]] ! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 21:39'! parseUidsFromHtmlDoc: aMIMEDocument | contentString start end uid uids hrefPrefix firstIdx doneOnce | contentString _ aMIMEDocument contents asString. hrefPrefix _ self hrefPrefixIn: contentString. hrefPrefix ifNil: [ ^ nil ]. start _ contentString findString: hrefPrefix. firstIdx _ start. doneOnce _ false. end _ contentString size. uids _ OrderedCollection new. [(end notNil and: [end > 0 and: [ doneOnce not ]]) and: [ start < contentString size ]] whileTrue: [ start _ self calculateUidStartInHtmlString: contentString startingAt: start. end _ self calculateUidEndInHtmlString: contentString startingAt: start. (end notNil and: [ end > 0 ]) ifTrue: [ uid _ self parseUidFrom: (contentString copyFrom: start to: end). uid ifNotNil: [ uids add: uid ]]. start _ contentString findString: hrefPrefix startingAt: start. doneOnce _ (start == 0) or: [ start == firstIdx ]. ]. ^ uids asSet asOrderedCollection! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/9/2003 11:57'! parseUidsFromTextDoc: aMIMEDocument "We expect a text/plain MIMEDocument with at least one number in it." "BugFixArchiveHttpClient parseUidsFromTextDoc: 'http://swiki.gsug.org:8080/sqfixes/last' asUrl retrieveContents" | contentString uidStrings uids | aMIMEDocument isNil ifTrue: [ ^ nil ]. (aMIMEDocument contentType = 'text/plain') ifFalse: [ ^ nil ]. contentString _ aMIMEDocument contents asString. "Check to make sure that the text/plain MIME doc is not an error message of some kind." ('*error*' match: contentString) ifTrue: [ ^ nil ]. uidStrings _ contentString findTokens: { Character lf. }. uidStrings isEmptyOrNil ifTrue: [ ^ nil ]. uids _ uidStrings collect: [ :ea | [ea asNumber] on: Error do: [ "Nothing -- bad data"]]. uids isEmptyOrNil ifTrue: [ ^ nil ]. uids _ uids asSortedCollection: [ :a :b | a > b ]. ^ uids ! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 12:19'! uidEndHtmlDelimiter ^ '.html'! ! !BugFixArchiveHttpClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 12:19'! uidStartHtmlDelimiter ^ '/'! ! !BugFixArchiveHttpClient class methodsFor: 'download utilities' stamp: 'bkv 6/28/2003 10:40'! archivePostFromChangeSetUrl: aUrlOrString "BugFixArchiveHttpClient archivePostFromChangeSetUrl: 'http://minnow.cc.gatech.edu/squeak/uploads/3257/KCP-0076-ValidateSubclassFormatFix.1.cs' " | cs titleIdx csTitle dateIdx csDate authorIdx csAuthor colonIdx endIdx emailList preamble startBracket endBracket csMimeDoc post | cs _ self changeSetFromUrl: aUrlOrString. cs ifNil: [ ^ nil ]. titleIdx _ cs findString: 'Change Set:'. colonIdx _ cs indexOf: $: startingAt: titleIdx. dateIdx _ cs findString: 'Date:'. "We don't use the actual title element from within the changeset, because we want to have consistently-titled ArchivePost objects." colonIdx _ cs indexOf: $: startingAt: dateIdx. authorIdx _ cs findString: 'Author:'. csDate _ (cs copyFrom: colonIdx + 1 to: authorIdx - 1) withBlanksTrimmed. colonIdx _ cs indexOf: $: startingAt: authorIdx. endIdx _ cs indexOf: Character cr startingAt: colonIdx. csAuthor _ (cs copyFrom: colonIdx + 1 to: endIdx - 1) withBlanksTrimmed. ('*@*' match: csAuthor) ifTrue: [ emailList _ MailAddressParser addressesIn: csAuthor ]. preamble _ (cs copyFrom: endIdx + 1 to: ((cs indexOf: $" startingAt: endIdx) - 1)) withBlanksTrimmed. csTitle _ self parseUidFrom: aUrlOrString asUrl path last. "Check for type-tags ( '[FIX]', '[ENH]', etc. -- if there are none, then add an [ENH] tag" startBracket _ csTitle indexOf: $[. endBracket _ csTitle indexOf: $]. ((startBracket == 0) and: [endBracket == 0]) ifTrue: [ csTitle _ '[ENH] ', csTitle. ]. csMimeDoc _ MIMEDocument contentType: 'text/plain' content: cs. post _ ArchivePost new. post title: csTitle. post authorName: csAuthor. emailList isEmptyOrNil ifFalse: [ post authorEmail: emailList first ]. post text: preamble. post dateSent: csDate asDate. post attachments: { csMimeDoc }. post sourceDocument: cs. post postUrl: aUrlOrString asUrl. ^ post ! ! !BugFixArchiveHttpClient class methodsFor: 'download utilities' stamp: 'bkv 6/24/2003 07:47'! archivePostFromUrl: aUrlOrString ('*.cs*' match: aUrlOrString asString) ifTrue: [ ^ self archivePostFromChangeSetUrl: aUrlOrString ] ifFalse: [ ^ BugFixArchiveMailClient archivePostFromUrl: aUrlOrString ]! ! !BugFixArchiveHttpClient class methodsFor: 'download utilities' stamp: 'bkv 6/28/2003 15:23'! changeSetFromUrl: aUrlOrString "BugFixArchiveHttpClient changeSetFromUrl: 'http://minnow.cc.gatech.edu/squeak/uploads/3257/KCP-0076-ValidateSubclassFormatFix.1.cs' " | url mimeDoc mimeStream changeList changeRecords | url _ aUrlOrString asUrl. mimeDoc _ url retrieveContents. mimeStream _ ReadStream on: mimeDoc contents. ((url schemeName = 'http') and: [((url httpErrorIndicator),'*') match: mimeStream contents asString]) ifTrue: [ Transcript cr; show: mimeStream contents asString. ^ nil ]. "Some kind of HTTP error has occurred" "Validate that this stream's contents are valid ChangeSet material" changeList _ ChangeList new scanStream: mimeStream from: 0 to: mimeStream size. changeList ifNil: [ ^ nil ]. changeRecords _ changeList changeList. changeRecords isEmptyOrNil ifTrue: [ ^ nil ]. "If validation succeeds, just return the stream's contents" ^ mimeStream contents! ! !BugFixArchiveMailClient methodsFor: 'initialization' stamp: 'nk 6/28/2003 13:51'! initialize mailDb _ Set new. hashes _ Set new. ! ! !BugFixArchiveMailClient methodsFor: 'accessing' stamp: 'bkv 5/27/2003 20:13'! archive ^archive! ! !BugFixArchiveMailClient methodsFor: 'accessing' stamp: 'bkv 5/30/2003 01:07'! archive: aBugFixArchive archive _ aBugFixArchive! ! !BugFixArchiveMailClient methodsFor: 'accessing' stamp: 'bkv 5/28/2003 22:45'! category ^ category! ! !BugFixArchiveMailClient methodsFor: 'accessing' stamp: 'bkv 5/28/2003 22:45'! category: aString category _ aString! ! !BugFixArchiveMailClient methodsFor: 'accessing' stamp: 'bkv 5/28/2003 22:44'! mailDb ^ mailDb ! ! !BugFixArchiveMailClient methodsFor: 'accessing' stamp: 'bkv 5/28/2003 22:43'! mailDb: aMailDB mailDb _ aMailDB. ! ! !BugFixArchiveMailClient methodsFor: 'accessing' stamp: 'bkv 5/31/2003 18:03'! repository self archive ifNil: [ ^ nil ]. ^ self archive repository! ! !BugFixArchiveMailClient methodsFor: 'updates' stamp: 'bkv 5/28/2003 23:24'! importMailMessage: aMailMessage | textHash newPost | textHash _ aMailMessage text hash. ( hashes includes: textHash ) ifTrue: [ ^ nil ] ifFalse: [ newPost _ self class archivePostFromMailMessage: aMailMessage. newPost ifNotNil: [ hashes add: textHash ]. ^ newPost ]. ! ! !BugFixArchiveMailClient methodsFor: 'updates' stamp: 'bkv 6/3/2003 15:36'! loadFromUid: aUid toUid: anotherUid fromUrl: aUrlOrString ^ self error: 'Implement me!!'! ! !BugFixArchiveMailClient methodsFor: 'updates' stamp: 'bkv 6/4/2003 17:07'! loadPreviousStopAfter: maxPosts ^ self error: 'Implement me!!'! ! !BugFixArchiveMailClient methodsFor: 'updates' stamp: 'bkv 5/28/2003 22:54'! loadUpdates | messageIds messageText textHash newPosts | newPosts _ Set new. messageIds _ self mailDb messagesIn: self category. messageIds do: [ :msgId | messageText _ self mailDb getText: msgId. textHash _ messageText hash. ( hashes includes: textHash ) ifFalse: [ newPosts add: (self class archivePostFromMailMessage: (MailMessage from: messageText)). hashes add: textHash. ]]. ^ newPosts asOrderedCollection copy! ! !BugFixArchiveMailClient methodsFor: 'updates' stamp: 'bkv 5/30/2003 10:57'! loadUpdatesStopAfter: maxUpdates | messageIds messageText textHash newPosts | newPosts _ Set new. messageIds _ self mailDb messagesIn: self category. ((maxUpdates > 0) and: [ messageIds size > maxUpdates ]) ifTrue: [ messageIds _ messageIds copyFrom: 1 to: maxUpdates ]. messageIds do: [ :msgId | messageText _ self mailDb getText: msgId. textHash _ messageText hash. ( hashes includes: textHash ) ifFalse: [ newPosts add: (self class archivePostFromMailMessage: (MailMessage from: messageText)). hashes add: textHash. ]]. ^ newPosts asOrderedCollection copy! ! !BugFixArchiveMailClient methodsFor: 'updates' stamp: 'bkv 5/31/2003 15:00'! reload: anArchivePost ^ self error: 'Implement me!!'! ! !BugFixArchiveMailClient methodsFor: 'updates' stamp: 'bkv 5/31/2003 14:58'! retrieveContentsFor: anArchivePost ^ self error: 'Implement me!!'! ! !BugFixArchiveMailClient methodsFor: 'testing' stamp: 'bkv 5/28/2003 23:01'! isHttpClient ^ false! ! !BugFixArchiveMailClient methodsFor: 'testing' stamp: 'bkv 5/28/2003 23:01'! isMailClient ^ true! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'jcg 7/4/2003 12:01'! archivePostFromMailMessage: aMailMessage "BugFixArchiveMailClient archivePostFromMailMessage: (BugFixArchiveMailClient mailMessageFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt')" | post aName fromLine emailList email body | aMailMessage ifNil: [ ^ nil ]. aMailMessage text isEmptyOrNil ifTrue: [ ^ nil ]. post _ ArchivePost new title: aMailMessage subject; yourself. fromLine _ aMailMessage from. [ emailList _ MailAddressParser addressesIn: fromLine. ] on: Error do: [ "A hack to handle the case where the from line is the email address followed by a sentence." ( fromLine beginsWith: '"' ) ifTrue: [ fromLine _ fromLine copyFrom: 2 to: fromLine size. ]. emailList _ fromLine findTokens: Character space. [ emailList _ MailAddressParser addressesIn: emailList first. ] on: Error do: [ emailList _ #() ]]. (emailList notEmpty) ifTrue: [ email _ emailList first ]. email ifNotNil: [ aName _ (aMailMessage from copyUpTo: $<) withBlanksTrimmed. ]. aName ifNotNil: [ ((aName beginsWith: '"') and: [aName endsWith: '"']) ifTrue: [ aName _ (aName findTokens: { $" }) first. ]]. post authorEmail: email. post authorName: aName. post dateSent: aMailMessage date asDate. (aMailMessage body isMultipart) ifTrue: [ | formattedParts textParts attachmentParts | "Attachments exist and have not yet been parsed from body of email and saved to filesystem." formattedParts _ self parsePartsFor: aMailMessage. (formattedParts isEmptyOrNil) ifFalse: [ attachmentParts _ (self attachmentPartsFrom: formattedParts) reject: [ :attachPart | attachPart name isEmptyOrNil ]. post attachments: attachmentParts. textParts _ self textPartsFrom: formattedParts. textParts isEmptyOrNil ifFalse: [ post text: (self streamContentsForTextParts: textParts) ]]] ifFalse: [ body _ aMailMessage format body content. post text: body. ]. ^ post ! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 6/27/2003 13:16'! archivePostFromUrl: aUrlOrString " BugFixArchiveMailClient archivePostFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt' " | url mailMessage archivePost | url _ aUrlOrString asUrl. mailMessage _ self mailMessageFromUrl: url. mailMessage ifNil: [ ^ nil ]. archivePost _ self archivePostFromMailMessage: mailMessage. archivePost sourceDocument: mailMessage. archivePost postUrl: url. ^ archivePost ! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 5/30/2003 17:34'! attachmentPartsFrom: aMailMessageAtomicParts aMailMessageAtomicParts isEmptyOrNil ifTrue: [ ^ #() ]. ^ aMailMessageAtomicParts select: [ :mailMsg | mailMsg notNil and: [ 'application/*' match: mailMsg body contentType ]].! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 5/28/2003 07:35'! collectPartsFrom: aMailMessage | parts | parts _ OrderedCollection new. ( aMailMessage body isMultipart ) ifTrue: [ parts addAll: aMailMessage atomicParts. ( parts isNil or: [ parts isEmpty ] ) ifTrue: [ ^ #() ]. parts do: [ :mailMsg | mailMsg format ]]. ^ parts ! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 6/30/2003 16:27'! mailMessageFromFile: aFileName | textFile mailMsg | textFile _ (CrLfFileStream readOnlyFileNamed: aFileName) text. mailMsg _ self parseMailMessageFromTextStream: textFile. textFile close. ^ mailMsg! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 6/30/2003 16:43'! mailMessageFromUrl: aUrlOrString " BugFixArchiveMailClient mailMessageFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt' " "Currently only supports text/plain downloads. Probably should be extended to handle application/octet-stream downloads of zipped mail." | mimeDoc mailMsg | mimeDoc _ self mimeDocumentFromUrl: aUrlOrString. mimeDoc ifNil: [ ^ nil ]. mailMsg _ self parseMailMessageFromTextStream: mimeDoc contents. ^ mailMsg! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 6/30/2003 16:43'! mimeDocumentFromUrl: aUrlOrString " BugFixArchiveMailClient mimeDocumentFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt' " "Currently only supports text/plain downloads. Probably should be extended to handle application/octet-stream downloads of zipped mail." | url mimeDoc | aUrlOrString ifNil: [ ^ nil ]. url _ aUrlOrString asUrl. mimeDoc _ url retrieveContents. mimeDoc ifNil: [ ^ nil ]. mimeDoc contents isEmpty ifTrue: [ ^ nil ]. ( mimeDoc contentType = 'text/plain' ) ifFalse: [ ^ nil ]. "Not supported right now." ((url schemeName = 'http') and: [((url httpErrorIndicator),'*') match: mimeDoc contents]) ifTrue: [ Transcript cr; show: mimeDoc contents. ^ nil ]. "Some kind of HTTP error has occurred" ^ mimeDoc! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 5/28/2003 08:00'! parseMailMessageFromTextStream: aStream | in out char mailMsg | "The downloaded email .txt file is assumed to be like the .txt files available from swiki.gsug.org, which have linefeeds in them that blow up the MailMessage parser. If we remove all line feeds, the MailMessage object created from this String seems to be just fine." in _ ReadStream on: aStream contents. out _ WriteStream on: ''. [ in atEnd ] whileFalse: [ ((char _ in next) == Character lf) ifFalse: [ out nextPut: char ]]. mailMsg _ MailMessage from: out contents. in close. out close. ^ mailMsg! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 6/1/2003 15:15'! parsePartsFor: aMailMessage ^ self collectPartsFrom: aMailMessage. ! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 6/2/2003 18:03'! streamContentsForTextParts: aListOfTextParts ^ String streamContents: [ :stream | aListOfTextParts do: [ :textPart | stream nextPutAll: textPart text. stream nextPut: Character cr ]]! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 5/28/2003 07:36'! textPartsFrom: aMailMessageAtomicParts ^ aMailMessageAtomicParts select: [ :mailMsg | mailMsg notNil and: [ (mailMsg body contentType = 'text/plain') or: [ mailMsg body contentType = 'text/html' ]]].! ! !BugFixArchiveMailClient class methodsFor: 'instance creation' stamp: 'bkv 5/28/2003 22:40'! onMailDB: aMailDB ^ self onMailDB: aMailDB withCategory: '.all' ! ! !BugFixArchiveMailClient class methodsFor: 'instance creation' stamp: 'bkv 5/28/2003 22:40'! onMailDB: aMailDB withCategory: aCategory ^ self new initialize mailDb: aMailDB; category: aCategory; yourself! ! !BugFixArchiveSwikiClient methodsFor: 'accessing' stamp: 'bkv 6/24/2003 17:45'! changesetPrefix ^ changesetPrefix ! ! !BugFixArchiveSwikiClient methodsFor: 'accessing' stamp: 'bkv 6/24/2003 17:45'! changesetPrefix: aString changesetPrefix _ aString! ! !BugFixArchiveSwikiClient methodsFor: 'accessing' stamp: 'bkv 6/24/2003 21:57'! localUidsForUrl: aUrlOrString | uids uidNumbers | uids _ super localUidsForUrl: aUrlOrString. uids ifNil: [ ^nil ]. uidNumbers _ OrderedCollection new. uids collect: [ :uid | uidChangesetNameMap values do: [ :mappedUids | (mappedUids includes: uid) ifTrue: [ uidNumbers add: (uidChangesetNameMap at: mappedUids) ]]]. ^ uidNumbers ! ! !BugFixArchiveSwikiClient methodsFor: 'accessing' stamp: 'bkv 6/24/2003 22:02'! serverUidsForUrl: aUrlOrString | uids uidNumbers | uids _ super serverUidsForUrl: aUrlOrString. uids ifNil: [ ^nil ]. uidNumbers _ OrderedCollection new. uids collect: [ :uid | uidChangesetNameMap values do: [ :mappedUids | (mappedUids includes: uid) ifTrue: [ uidNumbers add: (uidChangesetNameMap keyAtValue: mappedUids) ]]]. ^ uidNumbers ! ! !BugFixArchiveSwikiClient methodsFor: 'initialization' stamp: 'bkv 6/24/2003 11:10'! initialize super initialize. uidChangesetNameMap _ Dictionary new. ! ! !BugFixArchiveSwikiClient methodsFor: 'initialization' stamp: 'bkv 6/28/2003 14:06'! uidsSortBlock ^ [ :a :b | (self parseUidNumberFrom: a) > (self parseUidNumberFrom: b) ]! ! !BugFixArchiveSwikiClient methodsFor: 'updates' stamp: 'bkv 6/28/2003 14:06'! addUpdateUrl: aUrlOrString | newUids | newUids _ super addUpdateUrl: aUrlOrString. newUids do: [ :uid | (uidChangesetNameMap at: (self parseUidNumberFrom: uid) ifAbsentPut: [ OrderedCollection new ]) add: uid ]. ^ newUids! ! !BugFixArchiveSwikiClient methodsFor: 'updates' stamp: 'bkv 6/24/2003 13:04'! getServerUidRangeForUrl: aUrlOrString | url mimeDoc uids | url _ aUrlOrString asUrl. mimeDoc _ url retrieveContents. uids _ self parseUidsFromHtmlDoc: mimeDoc. ^ uids ! ! !BugFixArchiveSwikiClient methodsFor: 'updates' stamp: 'bkv 6/24/2003 18:03'! lastMaxUidFromUrl: aUrlOrString | srvUids | srvUids _ self serverUidsForUrl: aUrlOrString. srvUids isEmptyOrNil ifTrue: [ ^ nil ]. srvUids _ srvUids asSortedCollection: [ :a :b | a > b ]. ^ srvUids first! ! !BugFixArchiveSwikiClient methodsFor: 'updates' stamp: 'bkv 6/24/2003 22:12'! loadTokensForUidNumber: aNumber ^ uidChangesetNameMap at: aNumber ifAbsent: #() ! ! !BugFixArchiveSwikiClient methodsFor: 'updates' stamp: 'bkv 6/27/2003 20:02'! loadUid: aUid fromUrl: aUrlOrString | archivePost url loadTokens | aUid ifNil: [ ^ nil ]. url _ aUrlOrString asUrl. loadTokens _ self loadTokensForUidNumber: aUid. loadTokens do: [ :loadToken | [ archivePost _ self loadArchivePostWithUid: loadToken fromUpdatesUrl: url. ] on: Error do: ["Nothing right now"]. archivePost ifNotNil: [ ((self localUidsForUrl: url) includes: aUid) ifFalse: [ (self localUidsForUrl: url) add: aUid ]]]. ^ archivePost ! ! !BugFixArchiveSwikiClient methodsFor: 'updates' stamp: 'bkv 6/24/2003 18:03'! maxLocalUidFromUrl: aUrlOrString | locUids | locUids _ self localUidsForUrl: aUrlOrString. locUids isEmptyOrNil ifTrue: [ ^ nil ]. locUids _ locUids asSortedCollection: [ :a :b | a > b ]. ^ locUids first! ! !BugFixArchiveSwikiClient methodsFor: 'updates' stamp: 'bkv 6/25/2003 08:36'! saveDocumentFromUrl: aUrlOrString "If this client's archive is using a file repository, the client will send the MIMEDocument retrieved from the URL to the repository to be saved on the filesystem. This is a no-op for the BugFixArchiveSwikiClient; subclasses should override" ! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 22:38'! archivePostUrlFromUid: aUid forBaseUrl: aUrlOrString | baseUrl url | baseUrl _ aUrlOrString asUrl. url _ (baseUrl schemeName, '://', baseUrl authority, '/squeak/uploads/', baseUrl path last, '/', aUid asString, '.cs') asUrl. ^ url! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 13:01'! hrefPrefixIn: aString "We assume URLs structured as currently at the KCP 3.6 Swiki page." | idx hrefPrefix | hrefPrefix _ self uidStartHtmlDelimiter. idx _ aString findString: hrefPrefix. (idx == 0) ifTrue: [ ^ nil ]. ^ hrefPrefix! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 12:12'! kcpChangesetPrefix ^ 'KCP-'! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/28/2003 10:51'! parseChangeSetNameFrom: aString | startIdx dotIdx endIdx csName | aString isEmptyOrNil ifTrue: [ ^ nil ]. startIdx _ (aString lastIndexOf: $/) + 1. endIdx _ aString size. dotIdx _ aString findString: '.cs'. (dotIdx == 0) ifFalse: [ endIdx _ dotIdx - 1 ]. csName _ (aString copyFrom: startIdx to: endIdx) withBlanksTrimmed. ^ csName ! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 21:23'! parseUidFrom: aString "UID is kind of ambiguous for Swiki project posts. The changeset name is a UID, but the changeset number can also be considered a UID. It's more correct to return the changeset name, so that's what we do here. See BugFixArchiveSwikiClient >> parseUidNumberFrom: for extracting the changeset number." ^ self parseChangeSetNameFrom: aString ! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 21:15'! parseUidNumberFrom: aString | startIdx endIdx uid | aString isEmptyOrNil ifTrue: [ ^ nil ]. startIdx _ (aString indexOf: $-) + 1. endIdx _ (aString indexOf: $- startingAt: startIdx) - 1. uid _ (aString copyFrom: startIdx to: endIdx) withBlanksTrimmed asNumber. ^ uid ! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 12:54'! uidEndHtmlDelimiter ^ '.cs'! ! !BugFixArchiveSwikiClient class methodsFor: 'uuid utilities' stamp: 'bkv 6/24/2003 13:01'! uidStartHtmlDelimiter ^ '/squeak/uploads/'! ! !BugFixArchiveSwikiClient class methodsFor: 'instance creation' stamp: 'bkv 6/24/2003 17:46'! kcpSwikiArchiveClient "BugFixArchiveSwikiClient kcpSwikiArchiveClient" | client | client _ self new. client changesetPrefix: 'KCP-'. client initialize. client addUpdateUrl: self kcpSwikiUrl. ^ client! ! !BugFixArchiveSwikiClient class methodsFor: 'instance creation' stamp: 'bkv 6/24/2003 22:26'! kcpSwikiUrl ^ 'http://minnow.cc.gatech.edu/squeak/3257' asUrl! ! !ChangeList methodsFor: '*bug fix archive' stamp: 'bkv 6/23/2003 21:31'! scanStream: aStream from: startPosition to: stopPosition | itemPosition item prevChar | file _ aStream. changeList _ OrderedCollection new. list _ OrderedCollection new. listIndex _ 0. file position: startPosition. [file position < stopPosition] whileTrue: [[file atEnd not and: [file peek isSeparator]] whileTrue: [prevChar _ file next]. (file peekFor: $!!) ifTrue: [(prevChar = Character cr or: [prevChar = Character lf]) ifTrue: [self scanCategory]] ifFalse: [itemPosition _ file position. item _ file nextChunk. file skipStyleChunk. item size > 0 ifTrue: [self addItem: (ChangeRecord new file: file position: itemPosition type: #doIt) text: 'do it: ' , (item contractTo: 50)]]]. listSelections _ Array new: list size withAll: false! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/25/2003 13:06'! attachmentDirectoryFor: anArchivePost | serverUrl dir | serverUrl _ anArchivePost postUrl. dir _ ((serverUrl asString findString: BugFixArchiveSwikiClient uidStartHtmlDelimiter) == 0) ifTrue: [ self attachmentDirectoryForEmailUrl: serverUrl ] ifFalse: [ self attachmentDirectoryForChangesetUrl: serverUrl ]. ^ dir! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/1/2003 15:02'! attachmentsFor: anArchivePost | attachmentDir attachmentFileNames | anArchivePost ifNil: [ ^ nil ]. attachmentDir _ anArchivePost attachmentsDirectory. attachmentDir ifNil: [ ^ nil ]. attachmentFileNames _ attachmentDir fileNames. ^ attachmentFileNames! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/28/2003 12:47'! cleanUp "Get rid of empty files and empty directories." | emptyFiles emptyDirectories | self repositoryDir ifNil: [ ^ nil ]. emptyFiles _ self emptyFiles. emptyDirectories _ self emptyDirectories. emptyFiles do: [ :file | self repositoryDir deleteFileNamed: file name. ]. emptyDirectories do: [ :dir | self repositoryDir deleteDirectory: dir. ]. ^ { emptyFiles. emptyDirectories. }! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 5/31/2003 14:37'! directoryFor: anArchivePost | emailDir | anArchivePost ifNil: [ ^ nil ]. emailDir _ self directoryForEmailUrl: anArchivePost postUrl. emailDir exists ifFalse: [ ^ nil ]. ^ emailDir ! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/28/2003 12:00'! emptyDirectories | emptyDirs | self repositoryDir ifNil: [ ^ nil ]. emptyDirs _ OrderedCollection new. self repositoryDir withAllFilesDo: [ :f | ] andDirectoriesDo: [ :d | d entries isEmpty ifTrue: [ emptyDirs add: d ]]. ^ emptyDirs ! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/28/2003 12:02'! emptyFiles | emptyFiles | self repositoryDir ifNil: [ ^ nil ]. emptyFiles _ OrderedCollection new. self repositoryDir withAllFilesDo: [ :f | (f size == 0) ifTrue: [ emptyFiles add: f ]] andDirectoriesDo: [ :d | ]. ^ emptyFiles! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 5/31/2003 13:47'! fileNames self error: 'Fix to use upgraded storageUrl capabilities for EmailFileRepository'. ^ #()! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/3/2003 14:06'! mailMessages | messages | messages _ OrderedCollection new. self storageUrls do: [ :storageUrl | messages addAll: ( self mailMessagesStoredAtFileUrl: storageUrl ) ]. ^ messages ! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/3/2003 14:19'! mailMessagesStoredAtFileUrl: aUrlOrString | urlString messages | urlString _ aUrlOrString asString. messages _ OrderedCollection new. (self uidsStoredAtFileUrl: urlString ) do: [ :uid | | txtFileUrl | txtFileUrl _ (urlString, '/', uid asString, '.txt') asUrl. messages add: (BugFixArchiveMailClient mailMessageFromUrl: txtFileUrl). ]. ^ messages ! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 5/28/2003 08:02'! repositoryDir ^ repositoryDir! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/28/2003 12:04'! saveAttachmentsFor: anArchivePost | attachments attachmentDir savedFiles | attachments _ anArchivePost attachments. attachments isEmptyOrNil ifTrue: [ ^ nil ]. ( attachments notEmpty and: [ attachments first isString ]) ifTrue: [ ^ attachments ]. "Attachments exist and have not yet been parsed and saved to filesystem." attachmentDir _ anArchivePost attachmentsDirectory. attachmentDir assureExistence. savedFiles _ OrderedCollection new. attachments do: [ :part | | stream streamSize file fileSize sizeDiff | (part isKindOf: MailMessage) ifTrue: [ stream _ RWBinaryOrTextStream with: part body content. file _ attachmentDir fileNamed: part name. ] ifFalse: [ stream _ RWBinaryOrTextStream with: part content. file _ attachmentDir fileNamed: anArchivePost postUrl path last ]. streamSize _ stream contents size. fileSize _ file contents size. "Don't unnecessarily append to an existing file" sizeDiff _ streamSize - fileSize. (sizeDiff >= 0) ifTrue: [ file nextPutAll: (stream contents copyFrom: (streamSize - sizeDiff) + 1 to: streamSize ). ]. stream close. file close. savedFiles add: file name. ]. ^ savedFiles! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 6/30/2003 14:36'! saveSourceDocumentFor: anArchivePost | doc containerDir stream streamSize file fileSize sizeDiff | doc _ anArchivePost sourceDocument. doc ifNil: [ ^ nil ]. doc isString ifTrue: [ ^ nil ]. "The source document has not yet been saved to filesystem." containerDir _ self directoryForServerUrl: anArchivePost postUrl. containerDir assureExistence. (doc isKindOf: MailMessage) ifTrue: [ stream _ RWBinaryOrTextStream with: doc text asString. ] ifFalse: [ stream _ RWBinaryOrTextStream with: doc contents. ]. streamSize _ stream contents size. (streamSize == 0) ifTrue: [ ^ nil ]. file _ containerDir fileNamed: anArchivePost postUrl path last. file ifNil: [ ^ nil ]. fileSize _ file contents size. "Don't unnecessarily append to an existing file" sizeDiff _ streamSize - fileSize. (sizeDiff > 0) ifTrue: [ file nextPutAll: (stream contents copyFrom: (streamSize - sizeDiff) + 1 to: streamSize ). ]. stream close. "Don't keep around empty files." (file size == 0) ifTrue: [ containerDir deleteFileNamed: file name ] ifFalse: [ file close ]. ^ file! ! !EmailFileRepository methodsFor: 'uids' stamp: 'bkv 6/3/2003 14:17'! addFileUid: aUid forStorageUrl: aUrlOrString | urlString uids | urlString _ aUrlOrString asString. uids _ storageUrlUids at: urlString ifAbsentPut: OrderedCollection new. (uids includes: aUid) ifTrue: [ ^ nil ] ifFalse: [ uids add: aUid. ^ aUid ]. ! ! !EmailFileRepository methodsFor: 'uids' stamp: 'bkv 6/4/2003 10:15'! maxUidForServerUrl: aUrlOrString | locUids | locUids _ self uidsStoredAtFileUrl: aUrlOrString asString. locUids ifNil: [ ^ nil ]. locUids isEmpty ifTrue: [ ^ 0 ]. ^ locUids first! ! !EmailFileRepository methodsFor: 'uids' stamp: 'bkv 6/3/2003 14:18'! removeFileUid: aUid forStorageUrl: aUrlOrString | urlString uids | urlString _ aUrlOrString asString. uids _ storageUrlUids at: urlString ifAbsent: OrderedCollection new. (uids includes: aUid) ifTrue: [ uids remove: aUid. ^ aUid ] ifFalse: [ ^ nil ]. ! ! !EmailFileRepository methodsFor: 'uids' stamp: 'bkv 6/4/2003 09:52'! uidFromFileName: aFileName ^ self class uidFromFileName: aFileName ! ! !EmailFileRepository methodsFor: 'uids' stamp: 'bkv 6/3/2003 16:16'! uidsStoredAtFileUrl: aUrlOrString | fileUrlString locUids | fileUrlString _ (self storageUrlFor: aUrlOrString) asString. locUids _ storageUrlUids at: fileUrlString ifAbsent: [ nil ]. locUids ifNil: [ ^ nil ]. ^ locUids ! ! !EmailFileRepository methodsFor: 'initialization' stamp: 'bkv 5/31/2003 13:56'! baseDirName ^ 'email-file-repository'! ! !EmailFileRepository methodsFor: 'initialization' stamp: 'bkv 6/2/2003 15:43'! initialize serverUrls _ Dictionary new. storageUrlUids _ Dictionary new. ! ! !EmailFileRepository methodsFor: 'initialization' stamp: 'bkv 5/31/2003 13:57'! onDirectory: aDirectory "Set aDirectory as this repository's base directory." repositoryDir _ aDirectory. repositoryDir assurePathExists: self baseDirName. repositoryDir _ repositoryDir directoryNamed: self baseDirName. ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/25/2003 10:51'! addServerUrl: aUrlOrString | serverUrl storageUrl fileNames | serverUrl _ aUrlOrString asUrl. storageUrl _ self storageUrlFor: serverUrl. storageUrlUids at: (storageUrl asString) ifAbsentPut: (SortedCollection sortBlock: [ :a :b | a > b ]). self createDirsForUrl: storageUrl. fileNames _ self fileNamesForServerUrl: serverUrl. fileNames ifNotNil: [((storageUrlUids at: (storageUrl asString)) addAll: (fileNames collect: [ :fileName | self class uidFromFileName: fileName ])) select: [ :e | e notNil ]]. ^ storageUrl! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/25/2003 12:54'! attachmentDirectoryForChangesetUrl: aUrlOrString | csUrl csDir csFileName uid localDirName | csUrl _ aUrlOrString asUrl. csDir _ self directoryForChangesetUrl: csUrl. csDir ifNil: [ ^ nil ]. csFileName _ csUrl path last. uid _ self uidFromFileName: csFileName. localDirName _ uid asString, '-attachments'. ^ csDir directoryNamed: localDirName ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/2/2003 18:02'! attachmentDirectoryForEmailUrl: aUrlOrString | emailUrl emailDir emailFileName uid localDirName | emailUrl _ aUrlOrString asUrl. emailDir _ self directoryForEmailUrl: emailUrl. emailDir ifNil: [ ^ nil ]. emailFileName _ emailUrl path last. uid _ self uidFromFileName: emailFileName. localDirName _ uid asString, '-attachments'. ^ emailDir directoryNamed: localDirName ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/4/2003 10:05'! createDirsForUrl: aUrlOrString | url subDirNames containerDir currentDir | aUrlOrString asString isEmptyOrNil ifTrue: [ ^nil ]. url _ aUrlOrString asUrl. "We assume FileUrl input." containerDir _ self repositoryDir directoryNamed: url pathForDirectory. containerDir assureExistence. subDirNames _ containerDir pathParts. subDirNames add: url path last. subDirNames _ subDirNames reject: [ :any | (any endsWith: 'txt') or: [ repositoryDir pathParts includes: any ]]. currentDir _ repositoryDir. subDirNames do: [ :dName | currentDir assureExistenceOfPath: dName. currentDir _ currentDir directoryNamed: dName ]. ^ currentDir pathName! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/25/2003 12:57'! directoryForChangesetUrl: aUrlOrString | csUrl fileUrl dir | csUrl _ aUrlOrString asUrl. (csUrl schemeName = 'file') ifTrue: [ fileUrl _ csUrl ] ifFalse: [ fileUrl _ FileUrl new path: (self repositoryDir pathParts, { csUrl authority. }, (csUrl path reject: [ :any | any = 'uploads' ])) isAbsolute: true. ]. dir _ self repositoryDir directoryNamed: fileUrl pathForDirectory. ( dir exists ) ifTrue: [ ^ dir ] ifFalse: [ ^ nil ] ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/4/2003 14:34'! directoryForEmailUrl: aUrlOrString | emailUrl fileUrl dir | emailUrl _ aUrlOrString asUrl. (emailUrl schemeName = 'file') ifTrue: [ fileUrl _ emailUrl ] ifFalse: [ fileUrl _ FileUrl new path: (self repositoryDir pathParts, { emailUrl authority. }, emailUrl path) isAbsolute: true. ]. dir _ self repositoryDir directoryNamed: fileUrl pathForDirectory. ( dir exists ) ifTrue: [ ^ dir ] ifFalse: [ ^ nil ] ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/30/2003 13:41'! directoryForServerUrl: aUrlOrString | storageUrl dir | self repositoryDir ifNil: [ ^ nil ]. storageUrl _ self storageUrlFor: aUrlOrString. (storageUrl path last endsWith: '.txt') ifTrue: [ ^ self directoryForEmailUrl: storageUrl ]. (storageUrl path last endsWith: '.cs') ifTrue: [ ^ self directoryForChangesetUrl: storageUrl ]. dir _ self repositoryDir directoryNamed: storageUrl pathForFile. ( dir exists ) ifTrue: [ ^ dir ] ifFalse: [ ^ nil ]! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/1/2003 17:21'! directoryUrlFor: aUrlOrString "Returns the container directory's FileUrl for this email URL, if this URL points to an email .txt file and the appropriate container directory exists. Otherwise assume that this is a server URL and try to return the appropriate directory FileUrl." | mysteryUrl dirUrl | mysteryUrl _ aUrlOrString asUrl. mysteryUrl path isEmptyOrNil ifTrue: [ ^ nil ]. ((self serverUrls select: [ :any | any authority = mysteryUrl authority ]) isEmpty) ifTrue: [ ^ nil ]. (mysteryUrl path last endsWith: 'txt') ifTrue: [ | shortenedPath matches | shortenedPath _ mysteryUrl path copyFrom: 1 to: (mysteryUrl path size - 1). matches _ self serverUrls select: [ :any | (any authority = mysteryUrl authority) and: [ shortenedPath = any path ]]. matches isEmptyOrNil ifFalse: [ dirUrl _ self storageUrlFor: matches first ]] ifFalse: [ dirUrl _ self storageUrlFor: mysteryUrl ]. ^ dirUrl! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 5/31/2003 13:40'! fileNameForEmailUrl: aUrlOrString | emailUrl dir emailFileName | emailUrl _ aUrlOrString asUrl. dir _ self directoryForEmailUrl: emailUrl. dir ifNil: [ ^ nil ]. emailFileName _ dir fullNameFor: emailUrl path last. ^ emailFileName ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 5/31/2003 14:11'! fileNamesForServerUrl: aUrlOrString | url dir | url _ aUrlOrString asUrl. dir _ self directoryForServerUrl: url. dir ifNil: [ ^ nil ]. ^ dir fileNames ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/1/2003 17:58'! fileUrlFor: anArchivePostOrUrl "This is a general query that may reasonably be expected to be sent an ArchivePost, or a URL that points to an email .txt file. In either case, return the appropriate FileUrl." ^ (anArchivePostOrUrl respondsTo: #postUrl) ifTrue: [ FileUrl new path: (self directoryFor: anArchivePostOrUrl) pathParts, anArchivePostOrUrl fileName isAbsolute: true ] ifFalse: [ (anArchivePostOrUrl asUrl schemeName = 'file') ifTrue: [ anArchivePostOrUrl asUrl ] ifFalse: [ FileUrl new path: (self repositoryDir pathParts), { anArchivePostOrUrl authority. }, anArchivePostOrUrl path isAbsolute: true ]]! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/3/2003 14:20'! removeServerUrl: aUrlOrString | url dir containerDir | url _ aUrlOrString asUrl. serverUrls removeKey: url ifAbsent: [ ^ nil ]. storageUrlUids removeKey: (self storageUrlFor: url) asString ifAbsent: [ ^ nil ]. dir _ self directoryForServerUrl: url. dir recursiveDelete. containerDir _ dir containingDirectory. containerDir deleteDirectory: dir. ^ url! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 5/31/2003 14:54'! retrieveContentsFor: anArchivePost ^ self retrieveContentsForEmailUrl: anArchivePost postUrl ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 5/31/2003 14:53'! retrieveContentsForEmailUrl: aUrlOrString | fileName dir fileUrl mimeDoc | dir _ self directoryForEmailUrl: aUrlOrString. dir ifNil: [ ^ nil ]. fileName _ self fileNameForEmailUrl: aUrlOrString. fileName ifNil: [ ^ nil ]. fileUrl _ FileUrl new path: dir pathParts, fileName isAbsolute: true. fileUrl ifNil: [ ^ nil ]. mimeDoc _ fileUrl retrieveContents. ^ mimeDoc! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/3/2003 14:24'! serverUrls ^ OrderedCollection withAll: (serverUrls keys collect: [ :urlString | urlString asUrl ])! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/27/2003 14:03'! storageUrlFor: aUrlOrString "Returns the FileUrl for this server Url. If the FileUrl has not already been stored, then it is created and stored internally." | url storageUrl | url _ aUrlOrString asUrl. storageUrl _ ('file' match: url schemeName) ifTrue: [ (serverUrls values includes: url asString) ifTrue: [ url ] ifFalse: [ nil ]. ] ifFalse: [ ((url path last endsWith: 'txt') or: [url path last endsWith: '.cs']) ifTrue: [ self fileUrlFor: url ] ifFalse: [ serverUrls at: url asString ifAbsentPut: (FileUrl new path: (repositoryDir pathParts, { url authority. }, url path) isAbsolute: true) asString ]]. ^ storageUrl asUrl ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/3/2003 14:24'! storageUrls ^ OrderedCollection withAll: (serverUrls values collect: [ :urlString | urlString asUrl ])! ! !EmailFileRepository class methodsFor: 'instance creation' stamp: 'bkv 5/31/2003 15:29'! gsugSwikiArchiveFileRepository "EmailFileRepository gsugSwikiArchiveFileRepository" ^ self onServerUrls: { BugFixArchiveHttpClient bugUpdatesUrl. BugFixArchiveHttpClient fixesEtcUpdatesUrl. } ! ! !EmailFileRepository class methodsFor: 'instance creation' stamp: 'bkv 6/24/2003 13:08'! kcpSwikiArchiveFileRepository "EmailFileRepository kcpSwikiArchiveFileRepository" ^ self onServerUrls: { BugFixArchiveSwikiClient kcpSwikiUrl. } ! ! !EmailFileRepository class methodsFor: 'instance creation' stamp: 'bkv 5/31/2003 12:27'! onDirectory: aDirectory ^ self new initialize onDirectory: aDirectory; yourself! ! !EmailFileRepository class methodsFor: 'instance creation' stamp: 'bkv 5/31/2003 15:32'! onServerUrls: aListOfUrls | repository | repository _ self onDirectory: FileDirectory default. aListOfUrls do: [ :urlOrString | repository addServerUrl: urlOrString asUrl ]. ^ repository ! ! !EmailFileRepository class methodsFor: 'utilities' stamp: 'bkv 6/24/2003 20:16'! uidFromChangeSetFileName: aFileName | lastSlashIndex startIdx endIdx changeSetName uid | aFileName isEmptyOrNil ifTrue: [ ^ nil ]. ( aFileName endsWith: '.cs' ) ifFalse: [ ^ nil ]. lastSlashIndex _ aFileName lastIndexOf: FileDirectory slash asCharacter. ( lastSlashIndex < 1 ) ifTrue: [ "local file name" lastSlashIndex _ 1. ]. startIdx _ (aFileName indexOf: $- startingAt: lastSlashIndex) + 1. endIdx _ (aFileName indexOf: $- startingAt: startIdx) - 1. (endIdx > startIdx) ifTrue: [ changeSetName _ aFileName copyFrom: startIdx to: endIdx. uid _ changeSetName asNumber. ^ uid ] ifFalse: [ ^ nil ]. ! ! !EmailFileRepository class methodsFor: 'utilities' stamp: 'bkv 6/24/2003 20:08'! uidFromFileName: aFileName aFileName isEmptyOrNil ifTrue: [ ^ nil ]. ( aFileName endsWith: '.txt' ) ifTrue: [ ^ self uidFromTextFileName: aFileName ]. ( aFileName endsWith: '.cs' ) ifTrue: [ ^ self uidFromChangeSetFileName: aFileName ]. ! ! !EmailFileRepository class methodsFor: 'utilities' stamp: 'bkv 6/24/2003 20:09'! uidFromTextFileName: aFileName | lastSlashIndex startIdx dotIndex endIdx uid | aFileName isEmptyOrNil ifTrue: [ ^ nil ]. ( aFileName endsWith: '.txt' ) ifFalse: [ ^ nil ]. lastSlashIndex _ aFileName lastIndexOf: FileDirectory slash asCharacter. ( lastSlashIndex < 1 ) ifTrue: [ "local file name" startIdx _ 1. ] ifFalse: [ startIdx _ lastSlashIndex + 1 ]. dotIndex _ aFileName indexOf: $. startingAt: lastSlashIndex. endIdx _ dotIndex - 1. (endIdx > startIdx) ifTrue: [ uid _ aFileName copyFrom: startIdx to: endIdx. ^ uid asNumber ] ifFalse: [ ^ nil ]. ! ! !FileDirectory methodsFor: 'testing' stamp: 'bkv 6/1/2003 18:04'! isUnix ^ false! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'nk 6/28/2003 11:03'! httpGetDocument: url args: args accept: mimeType request: requestString "Return the exact contents of a web object. Asks for the given MIME type. If mimeType is nil, use 'text/html'. An extra requestString may be submitted and must end with crlf. The parsed header is saved. Use a proxy server if one has been registered. tk 7/23/97 17:12" "Note: To fetch raw data, you can use the MIME type 'application/octet-stream'." | serverName serverAddr port sock header length bare page list firstData aStream index connectToHost connectToPort type newUrl | Socket initializeNetwork. bare _ (url asLowercase beginsWith: 'http://') ifTrue: [url copyFrom: 8 to: url size] ifFalse: [url]. bare _ bare copyUpTo: $#. "remove fragment, if specified" serverName _ bare copyUpTo: $/. page _ bare copyFrom: serverName size + 1 to: bare size. (serverName includes: $:) ifTrue: [ index _ serverName indexOf: $:. port _ (serverName copyFrom: index+1 to: serverName size) asNumber. serverName _ serverName copyFrom: 1 to: index-1. ] ifFalse: [ port _ self defaultPort ]. page size = 0 ifTrue: [page _ '/']. "add arguments" args ifNotNil: [page _ page, (self argString: args) ]. (self shouldUseProxy: serverName) ifFalse: [ connectToHost _ serverName. connectToPort _ port ] ifTrue: [ page _ 'http://', serverName, ':', port printString, page. "put back together" connectToHost _ HTTPProxyServer. connectToPort _ HTTPProxyPort]. serverAddr _ NetNameResolver addressForName: connectToHost timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', connectToHost]. 3 timesRepeat: [ sock _ HTTPSocket new. sock connectTo: serverAddr port: connectToPort. (sock waitForConnectionUntil: (self deadlineSecs: 30)) ifFalse: [ Socket deadServer: connectToHost. sock destroy. ^ 'Server ',connectToHost,' is not responding']. "Transcript cr;show: url; cr. Transcript show: page; cr." sock sendCommand: 'GET ', page, ' HTTP/1.0', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Host: ', serverName, ':', port printString, CrLf. "blank line automatically added" list _ sock getResponseUpTo: CrLf, CrLf ignoring: (String with: CR). "list = header, CrLf, CrLf, beginningOfData" header _ list at: 1. "Transcript show: page; cr; show: header; cr." firstData _ list at: 3. header isEmpty ifTrue: [aStream _ 'server aborted early'] ifFalse: [ "dig out some headers" sock header: header. length _ sock getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ sock getHeader: 'content-type'. sock responseCode first = $3 ifTrue: [ newUrl _ sock getHeader: 'location'. newUrl ifNotNil: [ Transcript show: 'redirecting to ', newUrl; cr. sock destroy. newUrl _ self expandUrl: newUrl ip: serverAddr port: connectToPort. ^self httpGetDocument: newUrl args: args accept: mimeType] ]. aStream _ sock getRestOfBuffer: firstData totalLength: length. "a 400-series error" sock responseCode first = $4 ifTrue: [^ header, aStream contents]. ]. sock destroy. "Always OK to destroy!!" aStream class ~~ String ifTrue: [ ^ MIMEDocument contentType: type content: aStream contents url: url]. aStream = 'server aborted early' ifTrue: [ ^aStream ] ]. {'HTTPSocket class>>httpGetDocument:args:accept:request:'. aStream. url} inspect. ^'some other bad thing happened!!'! ! !MailMessage methodsFor: 'initialize-release' stamp: 'nk 7/2/2003 12:29'! setFields: fieldName to: aCollectionOfFieldValues "Set a field to a field value or collection of values. If any fields of the specified name exists, they will be overwritten" fields at: fieldName asLowercase put: aCollectionOfFieldValues asOrderedCollection. text := nil.! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'bkv 6/23/2003 14:17'! regenerateBodyFromParts "regenerate the message body from the multiple parts" | bodyText | bodyText := String streamContents: [ :str | str cr. parts do: [ :part | str cr; nextPutAll: '--'; nextPutAll: self attachmentSeparator; cr; nextPutAll: part text ]. str cr; nextPutAll: '--'; nextPutAll: self attachmentSeparator; nextPutAll: '--'; cr ]. body := MIMEDocument contentType: 'multipart/mixed' content: bodyText. text := nil. "text needs to be reformatted"! ! !UnixFileDirectory methodsFor: 'testing' stamp: 'bkv 6/1/2003 18:04'! isUnix ^ true! ! !Url methodsFor: 'as yet unclassified' stamp: 'nk 6/28/2003 09:34'! = otherUrl ^self species == otherUrl species and: [ fragment = otherUrl fragment ]! ! !Url methodsFor: 'as yet unclassified' stamp: 'nk 6/28/2003 09:36'! hash ^(self species hash + fragment hash) hashMultiply! ! !FileUrl methodsFor: 'access' stamp: 'bkv 6/2/2003 14:34'! pathForDirectory "Path using local file system's delimiter. $\ or $:" ^ String streamContents: [ :s | isAbsolute ifTrue: [ FileDirectory default isUnix ifTrue: [ s nextPut: $/ ]]. 1 to: self path size - 1 do: [ :ii | s nextPutAll: (path at: ii); nextPut: FileDirectory default pathNameDelimiter ] ]! ! !FileUrl methodsFor: 'access' stamp: 'bkv 6/1/2003 18:07'! pathForFile "Path using local file system's delimiter. $\ or $:" | first | ^String streamContents: [ :s | first _ FileDirectory default isUnix not. self path do: [ :p | first ifFalse: [ s nextPut: FileDirectory default pathNameDelimiter ]. first _ false. s nextPutAll: p ] ]! ! !FileUrl methodsFor: 'as yet unclassified' stamp: 'nk 6/28/2003 09:37'! = otherUrl ^super = otherUrl and: [ path = otherUrl path and: [ isAbsolute = otherUrl isAbsolute ]]! ! !FileUrl methodsFor: 'as yet unclassified' stamp: 'nk 6/28/2003 09:38'! hash ^(super hash + path hash + isAbsolute hash) hashMultiply ! ! !HttpUrl methodsFor: 'downloading' stamp: 'bkv 6/27/2003 16:34'! normalizeContents: webDocument (webDocument isKindOf: String) ifTrue: [ ^MIMEDocument contentType: 'text/plain' content: self httpErrorIndicator, self toText, ': ', webDocument url: (Url absoluteFromText: '')]. webDocument contentType = MIMEDocument defaultContentType ifTrue: [ ^MIMEDocument contentType: (MIMEDocument guessTypeFromName: self path last) content: webDocument content url: webDocument url ]. ^webDocument! ! !HttpUrl methodsFor: '*bug fix archive' stamp: 'bkv 5/30/2003 00:33'! asArchivePost ^ BugFixArchiveHttpClient archivePostFromUrl: self ! ! !HttpUrl methodsFor: '*bug fix archive' stamp: 'bkv 6/27/2003 16:34'! httpErrorIndicator ^ 'error occured retrieving '! ! !HttpUrl reorganize! ('downloading' askNamePassword checkAuthorization:retry: loadRemoteObjects normalizeContents: postFormArgs: postMultipartFormArgs: privateInitializeFromText:relativeTo: realm retrieveContents retrieveContentsAccept: retrieveContentsArgs: retrieveContentsArgs:accept:) ('testing' hasRemoteContents) ('*bug fix archive' asArchivePost httpErrorIndicator) ! !EmailFileRepository reorganize! ('files' attachmentDirectoryFor: attachmentsFor: cleanUp directoryFor: emptyDirectories emptyFiles fileNames mailMessages mailMessagesStoredAtFileUrl: repositoryDir saveAttachmentsFor: saveSourceDocumentFor:) ('uids' addFileUid:forStorageUrl: maxUidForServerUrl: removeFileUid:forStorageUrl: uidFromFileName: uidsStoredAtFileUrl:) ('initialization' baseDirName initialize onDirectory:) ('urls' addServerUrl: attachmentDirectoryForChangesetUrl: attachmentDirectoryForEmailUrl: createDirsForUrl: directoryForChangesetUrl: directoryForEmailUrl: directoryForServerUrl: directoryUrlFor: fileNameForEmailUrl: fileNamesForServerUrl: fileUrlFor: removeServerUrl: retrieveContentsFor: retrieveContentsForEmailUrl: serverUrls storageUrlFor: storageUrls) ! !BugFixArchiveSwikiClient class reorganize! ('uuid utilities' archivePostUrlFromUid:forBaseUrl: hrefPrefixIn: kcpChangesetPrefix parseChangeSetNameFrom: parseUidFrom: parseUidNumberFrom: uidEndHtmlDelimiter uidStartHtmlDelimiter) ('instance creation' kcpSwikiArchiveClient kcpSwikiUrl) ! !BugFixArchiveSwikiClient reorganize! ('accessing' changesetPrefix changesetPrefix: localUidsForUrl: serverUidsForUrl:) ('initialization' initialize uidsSortBlock) ('updates' addUpdateUrl: getServerUidRangeForUrl: lastMaxUidFromUrl: loadTokensForUidNumber: loadUid:fromUrl: maxLocalUidFromUrl: saveDocumentFromUrl:) ! !BugFixArchiveMailClient reorganize! ('initialization' initialize) ('accessing' archive archive: category category: mailDb mailDb: repository) ('updates' importMailMessage: loadFromUid:toUid:fromUrl: loadPreviousStopAfter: loadUpdates loadUpdatesStopAfter: reload: retrieveContentsFor:) ('testing' isHttpClient isMailClient) ! !BugFixArchiveHttpClient class reorganize! ('instance creation' gsugSwikiArchiveClient gsugSwikiFixesArchiveClient kcpSwikiArchiveClient withUpdateUrls:) ('class initialization' bugUpdatesUrl fixesEtcUpdatesUrl gsugSwikiUrl) ('uuid utilities' archivePostUrlFromUid:forBaseUrl: calculateUidEndInHtmlString:startingAt: calculateUidStartInHtmlString:startingAt: hrefPrefixIn: maxUidFromUrl: parseUidFrom: parseUidNumberFrom: parseUidsFromHtmlDoc: parseUidsFromTextDoc: uidEndHtmlDelimiter uidStartHtmlDelimiter) ('download utilities' archivePostFromChangeSetUrl: archivePostFromUrl: changeSetFromUrl:) ! !BugFixArchiveHttpClient reorganize! ('accessing' addRejectedUid:forUrl: archive archive: localUidsForUrl: rejectedUidsForUrl: repository serverUidsForUrl: updateUrls) ('initialization' initialize uidsSortBlock) ('modifying' addUpdateUrl: removeUpdateUrl:) ('testing' isHttpClient isMailClient) ('updates' archivePostFromUrl: archivePostUrlFromUid:forBaseUrl: asyncLoadUids:fromUrl: getServerUidRangeForUrl: lastMaxUidFromUrl: leastLocalUidFromUrl: loadArchivePostWithUid:fromUpdatesUrl: loadFromUid:toUid:fromUrl: loadPreviousStopAfter: loadServerUidsFromUrl: loadTokensForUidNumber: loadUid:fromUrl: loadUids:fromUrl: loadUpdates loadUpdatesStopAfter: maxLocalUidFromUrl: maxUidFromUrl: parseUidNumberFrom: parseUidsFromHtmlDoc: reload: repositoryUrlFromUid:forBaseUrl: retrieveContentsFor: synchronousLoadUids:fromUrl:) ! !BugFixArchive reorganize! ('accessing' archivePostGroups archivePosts httpClient: loadFilterSelectors loadFilterSelectors: mailClient: name printOn: repository repository: topics updateUrls updater) ('enumerating' announcementPosts approvedArchivePostGroups archivePostsSortedByDate bugPosts closedArchivePostGroups enhancementPosts fixPosts goodiePosts openArchivePostGroups postsForMonth: postsForMonth:andYear: postsForYear: postsWithAuthorEmail: postsWithAuthorName: postsWithAuthorNameOrEmail: postsWithBodyMatching: postsWithTitleMatching: postsWithTitleOrBodyMatching: updateStreamArchivePostGroups) ('initialization' initialize) ('modifying' addArchivePost: rebuildGroups removeArchivePost:) ('services' attachmentDirectoryFor: attachmentsFor: monthsRepresentedForYear: reload: retrieveContentsFor: saveAttachmentsFor: saveSourceDocumentFor: yearsRepresented) ('sorting' archivePostsSortedByUid dateAscendingSortBlock dateDescendingSortBlock defaultSortBlock sortByDateAscending sortByDateDescending sortByUidAscending sortByUidDescending uidAscendingSortBlock uidDescendingSortBlock) ('testing' hasAttachments isUpdatable isUpdatableFromHttp isUpdatableFromMailDB) ('updates' archivePostFromUrl: countMissingPostsFromUrl: listChanged loadFromUid:toUid:fromUrl: loadMissingPostsFromUrl: loadPreviousStopAfter: loadTheWholeEnchilada loadUids:fromUrl: loadUpdates loadUpdatesStopAfter:) ('validation' cleanUp missingUidsFromUrl: rejectedUidsForUrl: serverUidsForUrl: uidsDiffAgainstUrl: uidsForUrl:) ! !ArchivePostGroup reorganize! ('initialization' initialize printTopicOn: topicContentFrom: topicContentMatchesPost:) ('modifying' addPost: firstPost: removePost: updateAggregatedPost) ('accessing' aggregatedPost aggregatedQaTags allPosts archive firstPost posts topic) ('printing' printGroupDisplayLabelOn: printOn: printRepliesTextOn: printString) ('misc. queries' authorEmailMatches: authorNameMatches: authorNameOrEmailMatches: hasReviews isBefore:andAfter: leastRecentDate leastRecentPost maxUid mostRecentDate mostRecentPost numberOfReviews postDates size sizeMatches: titleOrBodyMatches: yearMatches:) ('queries about type' isAnnouncement isBug isBugAndFix isBugAndNotFix isBugOnly isEnhancement isFix isFixAndNotBug isGoodie) ('queries about status' hasNoStatus isMarkedAsApproved isMarkedAsClosed isMarkedAsUpdate) ! ArchivePost initialize! !ArchivePost reorganize! ('queries' authorEmailMatches: authorNameMatches: authorNameOrEmailMatches: bodyMatches: byteSize isBefore:andAfter: monthMatches: monthMatches:andYearMatches: size titleMatches: titleOrBodyMatches: yearMatches:) ('qa status testing' hasNoStatus isMarkedAsApproved isMarkedAsClosed isMarkedAsUpdate) ('qa flags testing' isMarkedAsHasBeenDocumented isMarkedAsHasBeenReviewed isMarkedAsHasBeenTested isMarkedAsHasSUnitTests isMarkedAsPassesSLint isMarkedAsSmall) ('types testing' isAnnouncement isBug isBugAndFix isBugAndNotFix isBugOnly isCanonicalType isEnhancement isFix isFixAndNotBug isGoodie) ('accessing' addQaTag: archive archive: attachments attachments: authorEmail authorEmail: authorName authorName: body comments comments: dateSent dateSent: groupDisplayLabel groupDisplayLabel: postUrl postUrl: qaFlags qaTags removeQaTag: sourceDocument sourceDocument: statusFlags statusTags text text: title title: typeTags types types: uid updateStreamNumbers) ('initialization' canonicalQaTags canonicalStatusTags canonicalTypeTags canonicalTypes flagForQaTag: flagForStatusTag: initialize initializeComments initializeQaFlags initializeStatusFlags initializeTypes initializeUid parseCommentsFromTitle parseFlagsFromTitleUsingTagConverterSelector: parseQaFlagsFromTitle parseStatusFlagsFromTitle parseTypeTagsFromTitle tagForQaFlag: tagForType: tagQaMap tagTypeMap) ('printing' describe:withBoldLabel:on: downloadFileName fullDescription printGroupDisplayLabelOn: printOn: printString) ('files' attachmentsDirectory fileName hasAttachments saveAttachments saveSourceDocument) ('services' asMailMessage asUrl reload retrieveContents) ('comparing' = hash) !