'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5269] on 18 June 2003 at 4:43:25 pm'! "Change Set: BugFixArchive-Model Date: 7 June 2003 Author: Brent Vukmer This framework provides a model for the Bug Fixes Archive.. er.. not that you can't tell that from the name. Change log: 1.12 Added some more error-handling when making network calls. Updated the get-max-uid-from-server code to use the 'last' URI provided by Bert Freudenberg. Now the local archive can just retrieve a text/plain MIMEDocument whose contents are a String that represents the most-recent/largest UID. Load-updates is now significantly faster."! Object subclass: #ArchivePost instanceVariableNames: 'archive 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 mailClient httpClient repository archivePosts topics archivePostGroups ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! !BugFixArchive commentStamp: 'bkv 5/30/2003 12:28' prior: 0! A local cache of the Squeak community's Bug Fixes Archive. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! Object subclass: #BugFixArchiveHttpClient instanceVariableNames: 'archive serverUids localUids ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! Object subclass: #BugFixArchiveMailClient instanceVariableNames: 'archive mailDb category hashes ' 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: '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/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/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/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 6/9/2003 21:34'! initialize self title ifNil: [ self title: ''. ]. self saveAttachments. ! ! !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/2/2003 10:07'! 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 ifTrue: [self describe: '' withBoldLabel: 'Date Posted: ' on: s] 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: '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 5/21/2003 21:15'! reload self archive reload: 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 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 5/15/2003 22:59'! initializeTopic topic _ String streamContents: [ :stream | self printTopicOn: stream ].! ! !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: 'bkv 6/3/2003 23:18'! 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. (self size == 1) ifTrue: [ self initializeTopic ]. 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/2/2003 17:00'! 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. textStream nextPutAll: 'Most recent post: ', self mostRecentPost groupDisplayLabel. textStream nextPut: Character cr. textStream nextPutAll: 'Aggregated QA tags:'. textStream nextPut: Character cr. self aggregatedQaTags do: [ :tag | textStream nextPutAll: tag ]]). 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/10/2003 08:49'! hasNoStatus | strictStatusTests relaxedStatusTests | strictStatusTests _ (self isMarkedAsApproved not and: [ self isMarkedAsClosed not ]) and: [ self isMarkedAsUpdate not ]. relaxedStatusTests _ ((self posts select: [ :each | '*approve*' match: each title ]) isEmpty) and: [ (self posts select: [ :each | '*close*' match: each title ]) isEmpty and: [ (self posts select: [ :each | '*update -*' match: each title ]) isEmpty ]]. ^ strictStatusTests and: [ relaxedStatusTests ]! ! !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: 'modifying' stamp: 'bkv 6/3/2003 21:42'! 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 saveAttachments. groupTopic _ ArchivePostGroup topicContentFrom: aPost title. (groupTopic isEmptyOrNil) ifFalse: [ | matchingGroup | topics add: groupTopic. 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: '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: 'bkv 5/28/2003 22:59'! httpClient ^ httpClient! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/28/2003 23:02'! httpClient: anHttpClient mailClient ifNotNil: [ self error: 'A BugFixArchive must use either an HTTP client or a mail client; it can''t use both, by orders of the management.' ]. anHttpClient isHttpClient ifFalse: [ self error: 'I don''t have a very good feeling about this.' ]. httpClient _ 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: 'bkv 5/28/2003 22:59'! mailClient ^ mailClient! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/28/2003 23:02'! mailClient: aMailClient httpClient ifNotNil: [ self error: 'A BugFixArchive must use either an HTTP client or a mail client; it can''t use both, by orders of the management.' ]. aMailClient isMailClient ifFalse: [ self error: 'I don''t have a very good feeling about this.' ]. mailClient _ aMailClient.! ! !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 5/28/2003 23:00'! updater self mailClient ifNotNil: [ ^ self mailClient ]. self httpClient ifNotNil: [ ^ self httpClient ].! ! !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 6/9/2003 18:59'! 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: '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: 'bkv 6/9/2003 13:10'! initialize archivePosts _ OrderedCollection new. archivePostGroups _ SortedCollection sortBlock: [ :a :b | a maxUid > b maxUid ]. topics _ Set new. loadFilterSelectors _ self class defaultLoadFilterSelectors. ! ! !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 5/31/2003 14:59'! reload: anArchivePost "Re-initialize this post with data retrieved from 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 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: '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: 'bkv 5/29/2003 23:13'! isUpdatableFromHttp ^ self httpClient notNil and: [ self httpClient isHttpClient ]! ! !BugFixArchive methodsFor: 'testing' stamp: 'bkv 5/29/2003 23:12'! isUpdatableFromMailDB ^ self mailClient notNil and: [ self mailClient 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/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/4/2003 17:10'! loadPreviousStopAfter: maxPosts | newPosts | newPosts _ self updater loadPreviousStopAfter: maxPosts. ^ newPosts ! ! !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 class methodsFor: 'instance creation' stamp: 'bkv 5/28/2003 23:12'! defaultArchive "BugFixArchive defaultArchive" ^ self gsugSwikiArchive ! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'bkv 5/31/2003 17:15'! gsugSwikiArchive "BugFixArchive gsugSwikiArchive" | 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: 'bkv 6/3/2003 22:11'! gsugSwikiFixesArchive "BugFixArchive gsugSwikiFixesArchive" | 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: 'bkv 5/28/2003 08:59'! 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/3/2003 22:37'! defaultLoadFilterSelectors ^ #( isFix isEnhancement )! ! !BugFixArchiveHttpClient methodsFor: 'initialization' stamp: 'bkv 6/1/2003 21:55'! initialize serverUids _ Dictionary new. localUids _ Dictionary new. ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/4/2003 17:49'! archivePostFromUrl: aUrlOrString "Returns the ArchivePost loaded from the given URL. If this client's archive is using a file repository, the client will send the intermediate result from retrieving the URL ( a MailMessage ) to the repository to be saved on the filesystem." | mailMsg post | mailMsg _ BugFixArchiveMailClient mailMessageFromUrl: aUrlOrString. mailMsg ifNil: [ ^ nil ]. self repository ifNotNil: [ self repository saveMailMessage: mailMsg fromUrl: aUrlOrString ]. post _ ArchivePost withMailMessage: mailMsg. post postUrl: aUrlOrString asUrl. ^ post! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/4/2003 17:44'! archivePostUrlFromUid: aUid forBaseUrl: aUrlOrString | url | url _ self class archivePostUrlFromUid: aUid forBaseUrl: aUrlOrString. self repository ifNotNil: [ ((self repository maxUidForServerUrl: aUrlOrString asUrl) < aUid) ifFalse: [ url _ self repository fileUrlFor: url ]]. ^ url! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/4/2003 17:14'! leastLocalUidFromUrl: aUrlOrString | locUids | locUids _ self localUidsForUrl: aUrlOrString. locUids isEmptyOrNil ifTrue: [ ^ nil ]. ^ locUids last! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/4/2003 09:43'! loadArchivePostWithUid: aUid fromUpdatesUrl: aUrlOrString | updatesUrl url archivePost | updatesUrl _ aUrlOrString asString. url _ self archivePostUrlFromUid: aUid forBaseUrl: updatesUrl. archivePost _ self archivePostFromUrl: url. "Should add a preference for whether to store FileUrl or HttpUrl. Right now always use HttpUrl." (archivePost postUrl isNil or: [ archivePost postUrl schemeName ~= 'http' ]) ifTrue: [ archivePost postUrl: updatesUrl asString, '/', aUid asString, '.txt'. ]. self archive ifNotNil: [ self archive addArchivePost: archivePost. ]. ^ archivePost! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/4/2003 09:50'! loadFromUid: aUid toUid: anotherUid fromUrl: aUrlOrString | newPosts url maxUid startUid endUid locUids retryUids loadUids | newPosts _ OrderedCollection new. retryUids _ OrderedCollection new. (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 ]]. locUids _ self localUidsForUrl: url. locUids isEmptyOrNil ifFalse: [ loadUids _ loadUids reject: [ :loadUid | locUids includes: loadUid ]]. loadUids do: [ :loadUid | | archivePost | [ archivePost _ self loadArchivePostWithUid: loadUid fromUpdatesUrl: url. ] on: Error do: [ retryUids add: loadUid ]. archivePost ifNotNil: [ newPosts add: archivePost. ((localUids at: url asString) includes: loadUid) ifFalse: [ (localUids at: url asString) add: loadUid ]]]. ^ newPosts ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/11/2003 16:18'! 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. ((endUid - startUid) > 1) ifTrue: [ newPosts addAll: (self loadFromUid: startUid toUid: endUid fromUrl: updateUrl). ]]]. ^ newPosts! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/9/2003 11:45'! loadServerUidsFromUrl: aUrlOrString | url currentUids prevMax maxUid newUids | url _ aUrlOrString asUrl. currentUids _ serverUids at: url asString ifAbsent: [ nil ]. currentUids ifNil: [ ^ nil ]. (currentUids isEmpty) ifTrue: [ prevMax _ 1 ] ifFalse: [ prevMax _ currentUids first + 1 ]. newUids _ SortedCollection sortBlock: [ :a :b | a > b ]. "Grab most recent uid from server." maxUid _ self maxUidFromUrl: url. maxUid ifNil: [ maxUid _ self lastMaxUidFromUrl: url ]. "Load the list of uids stored on the server. Assume a continuous list of integers." prevMax to: maxUid do: [ :uid | currentUids add: uid. newUids add: uid. ]. ^ newUids copy! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 5/30/2003 10:53'! loadUpdates ^ self loadUpdatesStopAfter: 0 ! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 6/12/2003 08:38'! loadUpdatesStopAfter: maxPosts | newPosts limit | newPosts _ OrderedCollection new. maxPosts isNil 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 _ serverMax - localMax ]. ((startUid > 0) and: [(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 6/2/2003 17:47'! reload: anArchivePost | reloadedPost | reloadedPost _ self class archivePostFromUrl: anArchivePost postUrl. reloadedPost ifNil: [ ^ nil ]. reloadedPost archive: anArchivePost archive. reloadedPost initialize. anArchivePost title: reloadedPost title. anArchivePost types: reloadedPost types. anArchivePost authorName: reloadedPost authorName. anArchivePost authorEmail: reloadedPost authorEmail. anArchivePost dateSent: reloadedPost dateSent. anArchivePost text: reloadedPost text. anArchivePost groupDisplayLabel: reloadedPost groupDisplayLabel. ^ anArchivePost! ! !BugFixArchiveHttpClient methodsFor: 'updates' stamp: 'bkv 5/31/2003 16:10'! retrieveContentsFor: anArchivePost ^ anArchivePost asUrl retrieveContents! ! !BugFixArchiveHttpClient methodsFor: 'modifying' stamp: 'bkv 6/3/2003 17:05'! addUpdateUrl: aUrlOrString | urlString | urlString _ aUrlOrString asString. serverUids at: urlString ifAbsentPut: (SortedCollection sortBlock: [ :a :b | a > b ]). localUids at: urlString ifAbsentPut: (SortedCollection sortBlock: [ :a :b | a > b ]). 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: '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/3/2003 16:01'! lastMaxUidFromUrl: aUrlOrString | srvUids | srvUids _ serverUids at: aUrlOrString asString ifAbsent: [ nil ]. srvUids isEmptyOrNil ifTrue: [ ^ nil ]. ^ srvUids first! ! !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 5/31/2003 09:22'! maxUidFromUrl: aUrlOrString ^ self class maxUidFromUrl: aUrlOrString! ! !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/3/2003 15:43'! updateUrls ^ serverUids keys collect: [ :urlString | urlString asUrl ]! ! !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 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/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/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 5/27/2003 22:29'! parseUidsFromHtmlDoc: aMIMEDocument "We assume URLs structured as currently at the GSUG swiki." | contentString start end uid uids hrefPrefix | contentString _ aMIMEDocument contents asString. uids _ Set new. hrefPrefix _ 'sqfixes/'. start _ contentString findString: hrefPrefix. ( start == 0 ) ifTrue: [ hrefPrefix _ 'sqbugs/'. ]. start _ contentString findString: hrefPrefix. ( start == 0 ) ifTrue: [ ^ nil ] ifFalse: [ start _ start + 1 ]. end _ contentString size. [ (end > 0) and: [ start < contentString size ]] whileTrue: [ start _ contentString findString: hrefPrefix startingAt: start. start _ ( contentString indexOf: $/ startingAt: start ) + 1. end _ ( contentString findString: '.html' startingAt: start ) - 1. ( end > 0 ) ifTrue: [ uid _ (contentString copyFrom: start to: end) asInteger. uid ifNotNil: [ uids add: uid ]]]. ^ uids 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: 'download utilities' stamp: 'bkv 5/28/2003 08:08'! archivePostFromUrl: aUrlOrString ^ BugFixArchiveMailClient archivePostFromUrl: aUrlOrString! ! !BugFixArchiveMailClient methodsFor: 'initialization' stamp: 'bkv 5/28/2003 22:36'! initialize mailDbs _ 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: 'bkv 6/4/2003 14:43'! archivePostFromMailMessage: aMailMessage "BugFixArchiveMailClient archivePostFromMailMessage: (BugFixArchiveMailClient mailMessageFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt')" | post aName fromLine emailList email body | 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 initialize. ^ post ! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 5/28/2003 08:06'! archivePostFromUrl: aUrlOrString " BugFixArchiveMailClient archivePostFromUrl: 'http://swiki.gsug.org:8080/sqfixes/2627.txt' " | url mailMessage archivePost | url _ aUrlOrString asUrl. mailMessage _ self mailMessageFromUrl: url. archivePost _ self archivePostFromMailMessage: 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 5/28/2003 08:00'! mailMessageFromFile: aFileName | textFile mailMsg | textFile _ (FileStream readOnlyFileNamed: aFileName) text. mailMsg _ self parseMailMessageFromTextStream: textFile. textFile close. ^ mailMsg! ! !BugFixArchiveMailClient class methodsFor: 'mail-message-utilities' stamp: 'bkv 5/28/2003 08:01'! mailMessageFromUrl: aUrlOrString "Currently only supports text/plain downloads. Probably should be extended to handle application/octet-stream downloads of zipped mail." | url mimeDoc mailMsg | url _ aUrlOrString asUrl. mimeDoc _ url retrieveContents. ( mimeDoc contentType = 'text/plain' ) ifFalse: [ ^nil ]. "Not supported right now." mailMsg _ self parseMailMessageFromTextStream: mimeDoc contents. ^ mailMsg! ! !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! ! !EmailFileRepository methodsFor: 'files' stamp: 'bkv 5/31/2003 14:30'! attachmentDirectoryFor: anArchivePost ^ self attachmentDirectoryForEmailUrl: anArchivePost postUrl! ! !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 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 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/4/2003 14:41'! 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 from body of email and saved to filesystem." attachmentDir _ anArchivePost attachmentsDirectory. attachmentDir assureExistence. savedFiles _ OrderedCollection new. attachments do: [ :part | | stream streamSize file fileSize sizeDiff | stream _ RWBinaryOrTextStream with: part body content. streamSize _ stream contents size. file _ attachmentDir fileNamed: part name. 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/4/2003 14:41'! saveMailMessage: aMailMessage fromUrl: aUrlOrString | url dir urlContentsSize fileSize sizeDiff file | aMailMessage ifNil: [ ^ nil ]. url _ aUrlOrString asUrl. url path isEmptyOrNil ifTrue: [ ^ nil ]. (url path last endsWith: 'txt') ifFalse: [ ^ nil ]. dir _ self directoryForEmailUrl: url. file _ dir fileNamed: url path last. urlContentsSize _ aMailMessage text size. fileSize _ file contents size. sizeDiff _ urlContentsSize - fileSize. (sizeDiff >= 0) ifTrue: [ file nextPutAll: (aMailMessage text copyFrom: (urlContentsSize - sizeDiff) + 1 to: urlContentsSize). ]. file close. ^ aMailMessage! ! !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: 'updates' stamp: 'bkv 6/6/2003 22:10'! saveUpdateUidsAsFile "This is a convenience method, hard-coded to connect to gsug.swiki.org over HTTP." self serverUrls do: [ :serverUrl | | dir serverMax localMax updatesFileName updatesFile | dir _ self directoryForServerUrl: serverUrl. updatesFileName _ 'updates.list'. (dir fileExists: updatesFileName) ifTrue: [ dir deleteFileNamed: updatesFileName ]. updatesFile _ dir fileNamed: updatesFileName. localMax _ self maxUidForServerUrl: serverUrl. serverMax _ BugFixArchiveHttpClient gsugSwikiArchiveClient maxUidFromUrl: serverUrl. serverMax ifNil: [ serverMax _ localMax ]. (localMax + 1) to: serverMax do: [ :fileUid | | archivePostUrl | archivePostUrl _ BugFixArchiveHttpClient archivePostUrlFromUid: fileUid forBaseUrl: serverUrl. updatesFile nextPutAll: archivePostUrl asString. updatesFile nextPut: Character lf. ]. updatesFile close. ].! ! !EmailFileRepository methodsFor: 'updates' stamp: 'bkv 6/3/2003 16:25'! updateFileUidsForServerUrl: aUrlOrString | url storageUids fileNames uids | url _ self storageUrlFor: aUrlOrString. storageUids _ storageUrlUids at: url asString ifAbsent: [ nil ]. storageUids ifNil: [ ^ nil ]. fileNames _ (self directoryForServerUrl: url) fileNames asOrderedCollection. fileNames isEmptyOrNil ifTrue: [ ^ nil ]. uids _ ((fileNames collect: [ :fileName | self uidFromFileName: fileName ]) reject: [ :uid | uid isNil ]) reject: [ :notNilUid | storageUids includes: notNilUid ]. storageUids addAll: uids. ^ uids ! ! !EmailFileRepository methodsFor: 'urls' stamp: 'bkv 6/3/2003 14:20'! addServerUrl: aUrlOrString | serverUrl storageUrl | serverUrl _ aUrlOrString asUrl. storageUrl _ self storageUrlFor: serverUrl. storageUrlUids at: (storageUrl asString) ifAbsentPut: (SortedCollection sortBlock: [ :a :b | a > b ]). self createDirsForUrl: storageUrl. self updateFileUidsForServerUrl: serverUrl. ^ storageUrl! ! !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/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/4/2003 10:00'! directoryForServerUrl: aUrlOrString | storageUrl containerDir dir | storageUrl _ self storageUrlFor: aUrlOrString. containerDir _ repositoryDir directoryNamed: storageUrl pathForDirectory. dir _ containerDir directoryNamed: storageUrl path last. ( 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/4/2003 14:37'! 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' ) 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 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/4/2003 09:52'! uidFromFileName: 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! ! !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 ] ]! ! !HttpUrl methodsFor: '*bug fixes archive viewer' stamp: 'bkv 5/30/2003 00:33'! asArchivePost ^ BugFixArchiveHttpClient archivePostFromUrl: self ! ! !UnixFileDirectory methodsFor: 'testing' stamp: 'bkv 6/1/2003 18:04'! isUnix ^ true! ! !EmailFileRepository reorganize! ('files' attachmentDirectoryFor: attachmentsFor: directoryFor: fileNames mailMessages mailMessagesStoredAtFileUrl: repositoryDir saveAttachmentsFor: saveMailMessage:fromUrl:) ('uids' addFileUid:forStorageUrl: maxUidForServerUrl: removeFileUid:forStorageUrl: uidFromFileName: uidsStoredAtFileUrl:) ('initialization' baseDirName initialize onDirectory:) ('updates' saveUpdateUidsAsFile updateFileUidsForServerUrl:) ('urls' addServerUrl: attachmentDirectoryForEmailUrl: createDirsForUrl: directoryForEmailUrl: directoryForServerUrl: directoryUrlFor: fileNameForEmailUrl: fileNamesForServerUrl: fileUrlFor: removeServerUrl: retrieveContentsFor: retrieveContentsForEmailUrl: serverUrls storageUrlFor: storageUrls) ! !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 withUpdateUrls:) ('class initialization' bugUpdatesUrl fixesEtcUpdatesUrl gsugSwikiUrl) ('uuid utilities' archivePostUrlFromUid:forBaseUrl: maxUidFromUrl: parseUidsFromHtmlDoc: parseUidsFromTextDoc:) ('download utilities' archivePostFromUrl:) ! !BugFixArchiveHttpClient reorganize! ('initialization' initialize) ('updates' archivePostFromUrl: archivePostUrlFromUid:forBaseUrl: leastLocalUidFromUrl: loadArchivePostWithUid:fromUpdatesUrl: loadFromUid:toUid:fromUrl: loadPreviousStopAfter: loadServerUidsFromUrl: loadUpdates loadUpdatesStopAfter: maxLocalUidFromUrl: reload: retrieveContentsFor:) ('modifying' addUpdateUrl: removeUpdateUrl:) ('accessing' archive archive: lastMaxUidFromUrl: localUidsForUrl: maxUidFromUrl: repository serverUidsForUrl: updateUrls) ('testing' isHttpClient isMailClient) ! !ArchivePostGroup reorganize! ('initialization' initialize initializeTopic 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: isBefore:andAfter: monthMatches: monthMatches:andYearMatches: titleMatches: titleOrBodyMatches: yearMatches:) ('qa status testing' 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: 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) ('services' asMailMessage asUrl reload retrieveContents) !