'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5501] on 8 November 2003 at 9:26:26 pm'! "Change Set: BugFixArchive-Model Date: 21 August 2003 Author: Brent Vukmer This framework provides the model for the Bug Fixes Archive Viewer. See http://minnow.cc.gatech.edu/squeak/3214 for the BugFixArchiveViewer changelog and other details about the project.."! Object subclass: #ArchiveListing instanceVariableNames: 'rows loaded ' classVariableNames: '' poolDictionaries: '' category: 'BFAV-Model'! Object subclass: #ArchivePost instanceVariableNames: 'archive id title authorName authorEmail dateSent typeMask reviewStepsMask statusMask flags updateStreamNumbers displayLabel ' classVariableNames: 'TagQaMap TagStatusMap TagTypeMap ' poolDictionaries: '' category: 'BFAV-Model'! !ArchivePost commentStamp: 'bkv 9/2/2003 21:10' 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. See the BugFixArchive class for more details about how ArchivePost objects are used. Or just explore the BugFixArchive instances in memory: BugFixArchive allSubInstances explore. ! Object subclass: #ArchivePostGroup instanceVariableNames: 'posts aggregatedPost ' classVariableNames: '' poolDictionaries: '' category: 'BFAV-Model'! Object subclass: #ArchiveRepository instanceVariableNames: 'repositoryDir serverUrl ' classVariableNames: '' poolDictionaries: '' category: 'BFAV-Model'! Object subclass: #MailUtil instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'BFAV-Model'! Object subclass: #PatchArchive instanceVariableNames: 'repository archivePosts topicGroups ' classVariableNames: 'Registry ' poolDictionaries: '' category: 'BFAV-Model'! !ArchiveListing methodsFor: 'accessing' stamp: 'bkv 11/8/2003 00:03'! rows ^ rows copy! ! !ArchiveListing methodsFor: 'accessing' stamp: 'bkv 11/7/2003 23:59'! rows: aList loaded ifTrue: [ self error: 'This listing''s rows have already been loaded.' ]. rows _ aList. loaded _ true.! ! !ArchiveListing methodsFor: 'accessing' stamp: 'bkv 11/8/2003 00:04'! size ^ self rows size! ! !ArchiveListing methodsFor: 'initialization' stamp: 'bkv 11/8/2003 21:04'! initialize loaded _ false.! ! !ArchiveListing class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 00:03'! fromByteArray: aByteArray | listing fileRows | listing _ super new initialize. fileRows _ self rowsFromByteArray: aByteArray. listing rows: fileRows. ^ listing! ! !ArchiveListing class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:14'! fromFileNamed: aString ^ self fromFileStream: (FileDirectory default readOnlyFileNamed: aString)! ! !ArchiveListing class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 00:03'! fromFileStream: aStream | listing fileRows | listing _ super new initialize. fileRows _ self rowsFromFileStream: aStream. listing rows: fileRows. ^ listing! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/8/2003 20:49'! escapeListingRowElement: aString | escapedRow | escapedRow _ aString copyReplaceAll: '\' with: '\\' asTokens: false. escapedRow _ escapedRow copyReplaceAll: ':' with: '\:' asTokens: false. ^ escapedRow! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/7/2003 23:51'! findTokensInListingRow: aString | indexes prevIdx tokens | indexes _ self indexesForUnEscapedListingRow: aString. tokens _ OrderedCollection new. prevIdx _ 1. indexes do: [ :i | tokens add: (aString copyFrom: prevIdx to: i -1). prevIdx _ i + 1. ]. tokens add: (aString copyFrom: prevIdx to: aString size). ^ tokens! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/7/2003 23:51'! indexesForUnEscapedListingRow: aString | idx char last indexes | indexes _ OrderedCollection new. idx _ 1. last _ aString lastIndexOf: $:. [ idx < last ] whileTrue: [ char _ aString at: idx. (char = $:) ifTrue: [ indexes add: idx. idx _ idx + 1 ] ifFalse: [ (char = $\) ifTrue: [ "Skip backslash-escaped characters" idx _ idx + 2. ] ifFalse: [ idx _ idx + 1. ]]]. indexes add: last. "Colons within dates are not escaped currently. So just ignore all colons after the fifth un-escaped colon." indexes _ indexes copyFrom: 1 to: (self numListingRowElements - 1). ^ indexes ! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/8/2003 20:49'! listingRowFromString: aString | ivarValues tokens id title typeMask statusMask fromLine nameAndEmail authorName authorEmail dateProcessor rfc822Time dateSent | aString isEmptyOrNil ifTrue: [ ^ nil ]. ivarValues _ OrderedCollection new. tokens _ self findTokensInListingRow: aString. tokens isEmptyOrNil ifTrue: [ ^ nil ]. id _ tokens first asNumber. ivarValues add: id. title _ self unEscapeListingRowElement: (tokens at: 2). ivarValues add: title. typeMask _ (tokens at: 3) asNumber. ivarValues add: typeMask. statusMask _ (tokens at: 4) asNumber. ivarValues add: statusMask. fromLine _ tokens at: 5. nameAndEmail _ MailUtil nameAndEmailAddressFromLine: fromLine. authorName _ nameAndEmail first. ivarValues add: authorName. authorEmail _ nameAndEmail second. ivarValues add: authorEmail. dateProcessor _ MailMessage new. [ rfc822Time _ dateProcessor timeFrom: (tokens at: 6). dateSent _ (dateProcessor dateStringFrom: rfc822Time) asDate. ivarValues add: dateSent ] on: Error do: [ "Nothing right now." ]. ^ ivarValues! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/7/2003 23:50'! numListingRowElements ^ 6! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/7/2003 23:55'! rowsFromByteArray: aByteArray ^ self rowsFromString: aByteArray asString ! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/8/2003 00:01'! rowsFromFileStream: aFileStream ^ self rowsFromString: aFileStream text contents ! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/8/2003 00:14'! rowsFromString: listingString | stringRows listingRows | listingString ifNil: [ ^ nil ]. stringRows _ listingString findTokens: Character cr. listingRows _ stringRows collect: [ :str | self listingRowFromString: str ]. ^ listingRows! ! !ArchiveListing class methodsFor: 'parsing' stamp: 'bkv 11/8/2003 20:48'! unEscapeListingRowElement: aString | unEscapedRow | unEscapedRow _ aString copyReplaceAll: '\\' with: '\' asTokens: false. unEscapedRow _ unEscapedRow copyReplaceAll: '\:' with: ':' asTokens: false. ^ unEscapedRow! ! !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 11/4/2003 20:33'! authorEmail ^ authorEmail! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 22:20'! authorEmail: aString authorEmail _ aString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 20:33'! authorName ^ authorName ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 22:19'! authorName: aString authorName _ aString ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 21:20'! dateSent ^ dateSent! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 22:29'! dateSent: aDate dateSent _ aDate! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/15/2003 21:21'! displayLabel ^ displayLabel! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/15/2003 21:21'! displayLabel: aString displayLabel _ aString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/6/2003 12:52'! flags flags ifNil: [ flags _ self parseFlagsFromTitle ]. ^ flags! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/4/2003 17:51'! id ^ id! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/4/2003 18:06'! id: aNumberOrString id _ aNumberOrString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/6/2003 13:33'! qaFlags ^ self flags intersection: self canonicalQaFlags! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 21:09'! reviewStepsMask ^ reviewStepsMask copy! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/8/2003 21:08'! reviewStepsMask: aBoolean reviewStepsMask _ aBoolean.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/6/2003 13:34'! statusFlags ^ self flags intersection: self canonicalStatusFlags! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 21:09'! statusMask ^ statusMask copy! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 22:16'! statusMask: aNumber statusMask _ aNumber.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 22:12'! title ^ title! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 22:55'! title: aString title _ aString.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/6/2003 19:39'! topic | source | source _ self title withBlanksTrimmed. ^ self topicContentFrom: source ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/6/2003 14:23'! typeFlags ^ self flags intersection: self canonicalTypeFlags! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 21:09'! typeMask ^ typeMask copy! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 11/4/2003 22:16'! typeMask: aNumber typeMask _ aNumber.! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 9/6/2003 14:22'! updateStreamNumbers ^ updateStreamNumbers! ! !ArchivePost methodsFor: 'comparing' stamp: 'bkv 11/7/2003 14:37'! = otherPost self == otherPost ifTrue: [ ^ true ]. self species == otherPost species ifFalse: [ ^ false ]. self archive = otherPost archive ifFalse: [ ^ false ]. self id = otherPost id ifFalse: [ ^false ]. (self typeMask allMask: otherPost typeMask) ifFalse: [ ^ false ]. (self statusMask allMask: otherPost statusMask) ifFalse: [ ^ false ]. self updateStreamNumbers = otherPost updateStreamNumbers ifFalse: [ ^ false ]. ^ true! ! !ArchivePost methodsFor: 'comparing' stamp: 'bkv 9/6/2003 14:23'! hash | hash | hash _ self species hash. hash _ hash bitXor: self archive hash. hash _ hash bitXor: self id hash. hash _ hash bitXor: self flags hash. hash _ hash bitXor: self updateStreamNumbers hash. ^ hash! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 9/16/2003 22:04'! attachments "Pre-parsed and saved as files, we assume. Returns filenames." ^ self archive attachmentsForId: self id! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 9/16/2003 22:02'! attachmentsDirectory ^ self archive attachmentsDirectoryForId: self id! ! !ArchivePost methodsFor: 'files' stamp: 'bkv 5/30/2003 18:06'! hasAttachments ^ self attachments isEmptyOrNil not! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 9/6/2003 14:21'! initialize | tags | tags _ self parseTagsFromTitle. flags _ self flagsFromTags: tags. updateStreamNumbers _ self updateStreamNumbersFromTags: tags.! ! !ArchivePost methodsFor: 'mail headers' stamp: 'bkv 11/6/2003 08:26'! authorEmailFromMailMessage | mailMsg fromLine | mailMsg _ self asMailMessage. mailMsg ifNil: [ ^ nil ]. fromLine _ mailMsg from. ^ (MailUtil nameAndEmailAddressFromLine: fromLine) second ! ! !ArchivePost methodsFor: 'mail headers' stamp: 'bkv 11/6/2003 08:26'! authorNameFromMailMessage | mailMsg fromLine | mailMsg _ self asMailMessage. mailMsg ifNil: [ ^ nil ]. fromLine _ mailMsg from. ^ (MailUtil nameAndEmailAddressFromLine: fromLine) first ! ! !ArchivePost methodsFor: 'mail headers' stamp: 'bkv 9/3/2003 21:38'! body "We should probably pre-parse the body instead, save to a file, then load from that file here.." | mailMsg formattedBody | mailMsg _ self asMailMessage. mailMsg ifNil: [ ^ nil ]. (mailMsg body isMultipart) ifTrue: [ | formattedParts textParts | "Attachments exist and have not yet been parsed from body of email and saved to filesystem." formattedParts _ MailUtil parsePartsFor: mailMsg. (formattedParts isEmptyOrNil) ifFalse: [ textParts _ MailUtil textPartsFrom: formattedParts. ]. (textParts isEmptyOrNil) ifFalse: [ formattedBody _ MailUtil streamContentsForTextParts: textParts. ]] ifFalse: [ formattedBody _ mailMsg format body content. ]. ^ formattedBody! ! !ArchivePost methodsFor: 'mail headers' stamp: 'bkv 9/3/2003 08:24'! comments ^ self parseCommentsFromTitle! ! !ArchivePost methodsFor: 'mail headers' stamp: 'bkv 11/4/2003 21:19'! dateSentFromMailMessage | mailMsg | mailMsg _ self asMailMessage. mailMsg ifNil: [ ^ nil ]. ^ mailMsg date asDate! ! !ArchivePost methodsFor: 'mail headers' stamp: 'bkv 11/4/2003 22:10'! titleFromMailMessage ^ self asMailMessage subject! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 9/3/2003 08:26'! groupDisplayLabel ^ String streamContents: [ :stream | self printGroupDisplayLabelOn: stream ]! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 9/3/2003 21:47'! printGroupDisplayLabelOn: aStream | authorLabel | authorLabel _ self authorName. authorLabel isEmptyOrNil ifTrue: [ authorLabel _ self 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: '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 9/6/2003 14:23'! byteSize "Answer a (somewhat low) estimate of how much space I take up" " ArchivePost allSubInstances detectSum: [ :ea | ea byteSize ] " | dataSize | dataSize _ self class instSize * 4. dataSize _ dataSize + self id size * 4. dataSize _ dataSize + self flags size * 4. dataSize _ dataSize + self updateStreamNumbers size * 4. ^ dataSize! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/3/2003 14:49'! isBefore: beforeDate andAfter: afterDate | beforeCheck afterCheck result | self dateSent isNil ifTrue: [ ^ false ]. beforeCheck _ beforeDate isNil or: [ self dateSent < beforeDate ]. afterCheck _ afterDate isNil or: [ self dateSent > afterDate ]. result _ beforeCheck and: [ afterCheck ]. ^ result ! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/2/2003 10:10'! monthMatches: aMonth ^ aMonth isNil not and: [ self dateSent month = aMonth]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 6/2/2003 10:10'! monthMatches: aMonth andYearMatches: aYear ^ (self monthMatches: aMonth) and: [ self yearMatches: aYear ]! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 9/2/2003 20:51'! size "Bogus query for heterogenous collections" ^ 1! ! !ArchivePost methodsFor: 'queries' stamp: 'bkv 9/6/2003 19:38'! titleMatches: aString "Be inclusive by default. If there is no title text, return true." | title | title _ self title. ^ aString isEmptyOrNil not and: [ title isNil or: [ aString match: 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: 'review-step testing' stamp: 'bkv 9/6/2003 12:51'! isMarkedAsHasBeenDocumented ^ self flags includes: self class symbolForHasBeenDocumented! ! !ArchivePost methodsFor: 'review-step testing' stamp: 'bkv 9/6/2003 12:50'! isMarkedAsHasBeenReviewed ^ self flags includes: self class symbolForHasBeenReviewed! ! !ArchivePost methodsFor: 'review-step testing' stamp: 'bkv 9/6/2003 12:50'! isMarkedAsHasBeenTested ^ self flags includes: self class symbolForHasBeenTested! ! !ArchivePost methodsFor: 'review-step testing' stamp: 'bkv 9/6/2003 12:49'! isMarkedAsHasSUnitTests ^ self flags includes: self class symbolForHasSUnitTests! ! !ArchivePost methodsFor: 'review-step testing' stamp: 'bkv 9/6/2003 12:49'! isMarkedAsPassesSLint ^ self flags includes: self class symbolForPassesSLint! ! !ArchivePost methodsFor: 'review-step testing' stamp: 'bkv 9/6/2003 12:48'! isMarkedAsSmall ^ self flags includes: self class symbolForIsSmall! ! !ArchivePost methodsFor: 'status testing' stamp: 'bkv 9/6/2003 19:37'! hasNoStatus | strictStatusTests relaxedStatusTests title | strictStatusTests _ (self isMarkedAsApproved not and: [ self isMarkedAsClosed not ]) and: [ self isMarkedAsUpdate not ]. title _ self title. relaxedStatusTests _ (('*approve*' match: title) not and: [ ('*close*' match: title) not ]) and: [ ('*update -*' match: title) not ]. ^ strictStatusTests and: [ relaxedStatusTests ]! ! !ArchivePost methodsFor: 'status testing' stamp: 'bkv 9/6/2003 14:05'! isMarkedAsApproved ^ self flags includes: (self class symbolForHasBeenApproved)! ! !ArchivePost methodsFor: 'status testing' stamp: 'bkv 9/6/2003 14:05'! isMarkedAsClosed ^ self flags includes: (self class symbolForHasBeenClosed)! ! !ArchivePost methodsFor: 'status testing' stamp: 'bkv 9/6/2003 14:06'! isMarkedAsUpdate ^ self flags includes: (self class symbolForHasBecomeAnUpdate)! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 9/6/2003 12:51'! addQaTag: aString self error: 'Obsolete and rudely deprecated!!'! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 9/15/2003 21:39'! asMailMessage self archive ifNil: [ ^ nil ]. ^ self archive mailMessageForId: self id! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 9/13/2003 19:20'! rawAttachments "The attachments should already be parsed and saved as files. Here we force a re-parsing from the source file." | mailMsg atts | mailMsg _ self asMailMessage. mailMsg ifNil: [ ^ nil ]. atts _ #(). (mailMsg body isMultipart) ifTrue: [ | formattedParts | "Attachments exist and have not yet been parsed from body of email and saved to filesystem." formattedParts _ MailUtil parsePartsFor: mailMsg. (formattedParts isEmptyOrNil) ifFalse: [ atts _ MailUtil attachmentPartsFrom: formattedParts. ] ]. ^ atts ! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 9/6/2003 12:51'! removeQaTag: aString self error: 'Obsolete and rudely deprecated!!'! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/6/2003 13:38'! flagsFromTags: aListOfStrings | titleFlags | aListOfStrings isNil ifTrue: [ ^ nil ]. aListOfStrings isEmpty ifTrue: [ ^ flags ]. titleFlags _ OrderedCollection withAll: (self typeFlagsFromTags: aListOfStrings). titleFlags addAll: (self qaFlagsFromTags: aListOfStrings). titleFlags addAll: (self statusFlagsFromTags: aListOfStrings). ^ titleFlags! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/13/2003 20:19'! flagsFromTags: aListOfStrings usingSelector: aSymbol aListOfStrings isEmptyOrNil ifTrue: [ ^ #() ]. ^ aListOfStrings collect: [ :tag | self class perform: aSymbol with: tag ] thenSelect: [ :flag | flag notNil ] ! ! !ArchivePost methodsFor: 'title parsing' 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: 'title parsing' stamp: 'bkv 9/6/2003 13:39'! parseFlagsFromTitle ^ self flagsFromTags: self parseTagsFromTitle! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 11/4/2003 21:08'! parseReviewStepsMaskFromTitle ^ self class parseReviewStepsMaskFromTitle: self title ! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/14/2003 13:26'! parseTagsFromTitle ^ self class parseTagsFromString: self title! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/6/2003 13:55'! parseUpdateStreamNumbersFromTitle ^ self updateStreamNumbersFromTags: self parseTagsFromTitle! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/6/2003 13:29'! qaFlagsFromTags: aListOfStrings ^ self flagsFromTags: aListOfStrings usingSelector: #flagForQaTag: ! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/6/2003 13:29'! statusFlagsFromTags: aListOfStrings ^ self flagsFromTags: aListOfStrings usingSelector: #flagForStatusTag: ! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/6/2003 19:39'! topicContentFrom: aString | content parenIndex | ((parenIndex _ aString indexOf: $() > 0) ifTrue: [ content _ aString copyFrom: 1 to: (parenIndex - 1) ] ifFalse: [ content _ aString ]. ^ content withBlanksTrimmed! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/6/2003 13:27'! typeFlagsFromTags: aListOfStrings ^ self flagsFromTags: aListOfStrings usingSelector: #flagForTypeTag: ! ! !ArchivePost methodsFor: 'title parsing' stamp: 'bkv 9/6/2003 13:54'! updateStreamNumbersFromTags: aListOfStrings | updateTags updateTag source startIdx endIdx updateNumbers | updateNumbers _ OrderedCollection new. aListOfStrings ifNil: [ ^ nil ]. aListOfStrings isEmpty ifTrue: [ ^ updateNumbers ]. updateTags _ aListOfStrings select: [ :tag | '[update -*]' match: tag ]. updateTags isEmpty ifTrue: [ ^ updateNumbers ]. updateTag _ updateTags first. startIdx _ (updateTag indexOf: $-) + 1. endIdx _ (updateTag indexOf: $]) - 1. source _ (updateTag copyFrom: startIdx to: endIdx) withBlanksTrimmed. (source findTokens: { Character space. $-. }) do: [ :token | updateNumbers add: token asNumber ]. ^ updateNumbers ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 9/6/2003 13:34'! canonicalQaFlags ^ self class canonicalQaFlags ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/2/2003 10:05'! canonicalQaTags ^ self class canonicalQaTags ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 9/6/2003 13:34'! canonicalStatusFlags ^ self class canonicalStatusFlags ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/7/2003 16:35'! canonicalStatusTags ^ self class canonicalStatusTags ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 9/6/2003 13:32'! canonicalTypeFlags ^ self class canonicalTypeFlags ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/2/2003 10:05'! canonicalTypeTags ^ self class canonicalTypeTags ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/2/2003 08:56'! canonicalTypes ^ self class canonicalTypes ! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/2/2003 10:43'! flagForQaTag: aString ^ self class flagForQaTag: aString! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/9/2003 11:25'! flagForStatusTag: aString ^ self class flagForStatusTag: aString! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/2/2003 11:01'! qaTags ^ self qaFlags collect: [ :flag | self tagForQaFlag: flag ]! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/7/2003 16:41'! statusTags self statusFlags ifNil: [ ^ nil ]. ^ self statusFlags collect: [ :e | self class tagForStatusFlag: e ]! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 6/2/2003 10:59'! tagForQaFlag: aString ^ self class tagForQaFlag: aString! ! !ArchivePost methodsFor: 'title tags' stamp: 'bkv 9/6/2003 13:56'! tagForType: aSymbol ^ self class tagTypeMap keyAtValue: aSymbol ! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 11/6/2003 19:23'! isAnnouncement ^ self typeMask allMask: self class maskForAnnouncement! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 11/6/2003 19:24'! isBug ^ self typeMask allMask: self class maskForBug! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 9/6/2003 12:32'! isBugAndFix ^ self isBug and: [ self isFix ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 9/6/2003 12:32'! isBugAndNotFix ^ self isBug and: [ self isFix not ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 9/6/2003 12:46'! isBugOnly ^ (self isBug) and: [ self flags size = 1 ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 11/6/2003 20:02'! isCanonicalType "Returns whether this post has at least one of the canonical type tags." ^ self typeMask anyMask: self class maskForAllTypesCombined! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 11/6/2003 19:24'! isEnhancement ^ self typeMask allMask: self class maskForEnhancement! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 11/6/2003 19:24'! isFix ^ self typeMask allMask: self class maskForFix! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 9/6/2003 12:32'! isFixAndNotBug ^ self isFix and: [ self isBug not ]! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 11/6/2003 19:24'! isGoodie ^ self typeMask allMask: self class maskForGoodie! ! !ArchivePost methodsFor: 'types testing' stamp: 'bkv 9/6/2003 14:23'! typeTags ^ self typeFlags collect: [ :type | self tagForType: type ]! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 9/6/2003 13:32'! canonicalQaFlags ^ self tagQaMap values! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/2/2003 10:31'! canonicalQaTags ^ self tagQaMap keys! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 9/6/2003 13:32'! canonicalStatusFlags ^ self tagStatusMap values! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 6/7/2003 16:31'! canonicalStatusTags ^ self tagStatusMap keys! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 9/6/2003 13:31'! canonicalTypeFlags ^self tagTypeMap values! ! !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 9/6/2003 13:17'! flagForTypeTag: 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: 'parsing' stamp: 'bkv 11/4/2003 21:08'! parseReviewStepsMaskFromTitle: aString | rsMask | rsMask _ 0. (('*', self tagForHasBeenDocumented, '*') match: aString) ifTrue: [ rsMask _ rsMask bitOr: self maskForDocumented ]. (('*', self tagForHasBeenReviewed, '*') match: aString) ifTrue: [ rsMask _ rsMask bitOr: self maskForReviewed ]. (('*', self tagForHasSUnitTests, '*') match: aString) ifTrue: [ rsMask _ rsMask bitOr: self maskForSUnitTests ]. (('*', self tagForPassesSLint, '*') match: aString) ifTrue: [ rsMask _ rsMask bitOr: self maskForSLint ]. (('*', self tagForHasBeenTested, '*') match: aString) ifTrue: [ rsMask _ rsMask bitOr: self maskForTested ]. ^ rsMask! ! !ArchivePost class methodsFor: 'bit masks for review steps' stamp: 'bkv 11/4/2003 20:47'! maskForDocumented ^ 1! ! !ArchivePost class methodsFor: 'bit masks for review steps' stamp: 'bkv 11/4/2003 20:48'! maskForReviewed ^ 2! ! !ArchivePost class methodsFor: 'bit masks for review steps' stamp: 'bkv 11/4/2003 20:48'! maskForSLint ^ 4! ! !ArchivePost class methodsFor: 'bit masks for review steps' stamp: 'bkv 11/4/2003 20:50'! maskForSUnitTests ^ 16! ! !ArchivePost class methodsFor: 'bit masks for review steps' stamp: 'bkv 11/4/2003 20:50'! maskForSmall ^ 8! ! !ArchivePost class methodsFor: 'bit masks for review steps' stamp: 'bkv 11/4/2003 20:50'! maskForTested ^ 32! ! !ArchivePost class methodsFor: 'bit masks for status tags' stamp: 'bkv 11/8/2003 12:37'! maskForApproved ^ 1! ! !ArchivePost class methodsFor: 'bit masks for status tags' stamp: 'bkv 11/8/2003 12:38'! maskForClosed ^ 2! ! !ArchivePost class methodsFor: 'bit masks for status tags' stamp: 'bkv 11/8/2003 12:37'! maskForUpdate ^ 4! ! !ArchivePost class methodsFor: 'bit masks for type tags' stamp: 'bkv 11/6/2003 19:27'! maskForAllTypesCombined ^ ((((self maskForAnnouncement bitOr: self maskForBug) bitOr: self maskForEnhancement) bitOr: self maskForFix) bitOr: self maskForGoodie)! ! !ArchivePost class methodsFor: 'bit masks for type tags' stamp: 'bkv 11/4/2003 20:44'! maskForAnnouncement ^ 1! ! !ArchivePost class methodsFor: 'bit masks for type tags' stamp: 'bkv 11/4/2003 20:45'! maskForBug ^ 2! ! !ArchivePost class methodsFor: 'bit masks for type tags' stamp: 'bkv 11/4/2003 20:45'! maskForEnhancement ^ 4! ! !ArchivePost class methodsFor: 'bit masks for type tags' stamp: 'bkv 11/4/2003 20:45'! maskForFix ^ 8! ! !ArchivePost class methodsFor: 'bit masks for type tags' stamp: 'bkv 11/4/2003 20:45'! maskForGoodie ^ 16! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 9/6/2003 12:28'! initialize "ArchivePost initialize" self initializeTagQaMap. self initializeTagStatusMap. self initializeTagTypeMap.! ! !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 9/6/2003 14:08'! initializeTagTypeMap TagTypeMap _ Dictionary new. TagTypeMap at: self tagForAnnouncement put: self symbolForIsAnnouncement. TagTypeMap at: self tagForBug put: self symbolForIsBug. TagTypeMap at: self tagForEnhancement put: self symbolForIsEnhancement. TagTypeMap at: self tagForFix put: self symbolForIsFix. TagTypeMap at: self tagForGoodie put: self symbolForIsGoodie. ^ TagTypeMap! ! !ArchivePost class methodsFor: 'instance creation' stamp: 'bkv 9/4/2003 17:49'! archive: aBugFixArchive id: aNumberOrString ^ self new archive: aBugFixArchive; id: aNumberOrString; yourself! ! !ArchivePost class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 21:12'! archive: aBugFixArchive listingRow: aList | post | aList isEmptyOrNil ifTrue: [ ^ nil ]. post _ self archive: aBugFixArchive id: aList first. post title: (aList at: 2). post typeMask: (aList at: 3). post statusMask: (aList at: 4). post reviewStepsMask: (self parseReviewStepsMaskFromTitle: post title). post authorName: (aList at: 5). post authorEmail: (aList at: 6). (aList size > 6) ifTrue: [ post dateSent: (aList at: 7). ]. ^ post! ! !ArchivePost class methodsFor: 'type tags' stamp: 'bkv 9/6/2003 14:07'! tagForAnnouncement ^ '[ANN]'! ! !ArchivePost class methodsFor: 'type tags' stamp: 'bkv 9/6/2003 14:07'! tagForBug ^ '[BUG]'! ! !ArchivePost class methodsFor: 'type tags' stamp: 'bkv 9/6/2003 14:07'! tagForEnhancement ^ '[ENH]'! ! !ArchivePost class methodsFor: 'type tags' stamp: 'bkv 9/6/2003 14:07'! tagForFix ^ '[FIX]'! ! !ArchivePost class methodsFor: 'type tags' stamp: 'bkv 9/6/2003 14:07'! tagForGoodie ^ '[GOODIE]'! ! !ArchivePost class methodsFor: 'review step tags' stamp: 'bkv 6/2/2003 11:24'! tagForHasBeenDocumented ^ '[cd]' ! ! !ArchivePost class methodsFor: 'review step tags' stamp: 'bkv 6/2/2003 11:24'! tagForHasBeenReviewed ^ '[er]' ! ! !ArchivePost class methodsFor: 'review step tags' stamp: 'bkv 6/2/2003 11:24'! tagForHasBeenTested ^ '[et]' ! ! !ArchivePost class methodsFor: 'review step tags' stamp: 'bkv 6/2/2003 11:24'! tagForHasSUnitTests ^ '[su]' ! ! !ArchivePost class methodsFor: 'review step tags' stamp: 'bkv 6/2/2003 11:25'! tagForIsSmall ^ '[sm]' ! ! !ArchivePost class methodsFor: 'review step tags' stamp: 'bkv 6/2/2003 11:25'! tagForPassesSLint ^ '[sl]' ! ! !ArchivePost class methodsFor: 'status tags' stamp: 'bkv 6/7/2003 16:25'! tagForHasBecomeAnUpdate ^ '[update]' ! ! !ArchivePost class methodsFor: 'status tags' stamp: 'bkv 6/7/2003 16:24'! tagForHasBeenApproved ^ '[approved]' ! ! !ArchivePost class methodsFor: 'status tags' stamp: 'bkv 6/7/2003 16:24'! tagForHasBeenClosed ^ '[closed]' ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/7/2003 16:26'! symbolForHasBecomeAnUpdate ^ #hasBecomeAnUpdate ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/7/2003 16:26'! symbolForHasBeenApproved ^ #hasBeenApproved ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/7/2003 16:26'! symbolForHasBeenClosed ^ #hasBeenClosed ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/2/2003 11:39'! symbolForHasBeenDocumented ^ #hasBeenDocumented ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/2/2003 11:39'! symbolForHasBeenReviewed ^ #hasBeenReviewed ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/2/2003 11:40'! symbolForHasBeenTested ^ #hasBeenTested ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/2/2003 11:41'! symbolForHasSUnitTests ^ #hasSUnitTests ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 9/6/2003 12:26'! symbolForIsAnnouncement ^ #isAnnouncement ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 9/6/2003 12:26'! symbolForIsBug ^ #isBug ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 9/6/2003 12:26'! symbolForIsEnhancement ^ #isEnhancement ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 9/6/2003 12:26'! symbolForIsFix ^ #isFix ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 9/6/2003 12:27'! symbolForIsGoodie ^ #isGoodie ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/2/2003 11:40'! symbolForIsSmall ^ #isSmall ! ! !ArchivePost class methodsFor: 'flags' stamp: 'bkv 6/2/2003 11:40'! symbolForPassesSLint ^ #passesSLint ! ! !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 9/15/2003 20:06'! parseTagsFromString: aString "We allow ${ and $}, but convert them to $[ and $]. We allow $|, but convert it to $[. We treat mis-matching counts for $[ and $] as an error." | source startIdxs endIdxs tags tag start end | aString isEmptyOrNil ifTrue: [ ^ nil ]. source _ aString copyReplaceAll: '{' with: '['. source _ source copyReplaceAll: '}' with: ']'. source _ source copyReplaceAll: '|' with: '['. tags _ OrderedCollection new. startIdxs _ SortedCollection new. endIdxs _ SortedCollection new. 1 to: source size do: [ :idx | | char | char _ source at: idx. char == $[ ifTrue: [ startIdxs add: idx ] ifFalse: [ char == $] ifTrue: [ endIdxs add: idx ]]]. startIdxs size = endIdxs size ifFalse: [ self error: 'Tag open/close not matched evenly.' ]. 1 to: startIdxs size do: [ :idx | start _ startIdxs at: idx. end _ endIdxs at: idx. tag _ source copyFrom: start to: end. tags add: tag. ]. ^ tags ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 11/8/2003 12:21'! initialize posts _ SortedCollection sortBlock: PatchArchive new idDescendingSortBlock. ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 9/6/2003 19:39'! printTopicOn: aStream | content | self firstPost ifNil: [ aStream nextPutAll: ''. ^ aStream ]. content _ self firstPost topic. aStream nextPutAll: content. aStream nextPut: Character space. aStream nextPut: $(. aStream nextPutAll: self firstPost dateSent asString. aStream nextPut: $). ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 9/6/2003 19:40'! topicContentMatchesPost: anArchivePost self firstPost ifNil: [ ^ true ]. ^ self firstPost topic = anArchivePost topic! ! !ArchivePostGroup methodsFor: 'modifying' stamp: 'bkv 11/8/2003 20:36'! addPost: anArchivePost anArchivePost displayLabel: anArchivePost groupDisplayLabel. "Be incredibly permissive here in the interests of speed; don't check whether anArchivePost's topic matches the topic for this group." posts add: anArchivePost. ! ! !ArchivePostGroup methodsFor: 'modifying' stamp: 'bkv 11/8/2003 20:37'! firstPost: anArchivePost "If the topic is already set, don't set a first post that doesn't match the topic." posts notEmpty ifTrue: [ ^ nil ]. anArchivePost displayLabel: anArchivePost topic. 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 9/4/2003 18:08'! updateAggregatedPost self firstPost ifNil: [ ^ nil ]. aggregatedPost ifNil: [ aggregatedPost _ ArchivePost new. ]. self error: 'No more ArchivePost#title:'. self error: 'No more ArchivePost#groupDisplayLabel:'. posts do: [ :post | post qaTags do: [ :qaTag | aggregatedPost addQaTag: qaTag ]]. 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 9/4/2003 17:23'! maxId self posts isEmptyOrNil ifTrue: [ ^ nil ]. ^ (self posts asSortedCollection: [ :a :b | a id > b id ]) first id ! ! !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 7/29/2003 20:17'! titleMatches: aString self aggregatedPost ifNil: [ ^ false ]. ^ self aggregatedPost titleMatches: aString ! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:42'! titleOrBodyMatches: aString ^ (posts select: [ :any | any titleOrBodyMatches: aString ]) notEmpty! ! !ArchivePostGroup methodsFor: 'misc. queries' stamp: 'bkv 6/3/2003 14:42'! yearMatches: aString ^ (posts select: [ :any | any yearMatches: aString ]) notEmpty! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:56'! isAnnouncement ^ self firstPost notNil and: [ self firstPost isAnnouncement ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:55'! isBug ^ self firstPost notNil and: [ self firstPost isBug ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:57'! isBugAndFix ^ self isBug and: [ self isFix ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:57'! isBugAndNotFix ^self isBug and: [ self isFix not ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:58'! isBugOnly ^ self firstPost notNil and: [ self firstPost isBugOnly ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:56'! isEnhancement ^ self firstPost notNil and: [ self firstPost isEnhancement ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:55'! isFix ^ self firstPost notNil and: [ self firstPost isFix ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:58'! isFixAndNotBug ^self isFix and: [ self isBug not ]! ! !ArchivePostGroup methodsFor: 'queries about type' stamp: 'bkv 5/29/2003 22:56'! isGoodie ^ self firstPost notNil and: [ self firstPost isGoodie ]! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/30/2003 19:06'! hasNoStatus | slackers | slackers _ self posts select: [ :post | post hasNoStatus ]. ^ slackers size == self size ! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/9/2003 22:57'! isMarkedAsApproved self firstPost ifNil: [ ^ false ]. ^ (self posts select: [ :any | any isMarkedAsApproved ]) notEmpty! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/9/2003 22:58'! isMarkedAsClosed self firstPost ifNil: [ ^ false ]. ^ (self posts select: [ :any | any isMarkedAsClosed ]) notEmpty! ! !ArchivePostGroup methodsFor: 'queries about status' stamp: 'bkv 6/9/2003 22:58'! isMarkedAsUpdate self firstPost ifNil: [ ^ false ]. ^ (self posts select: [ :any | any isMarkedAsUpdate ]) notEmpty! ! !ArchivePostGroup class methodsFor: 'instance creation' stamp: 'bkv 6/2/2003 14:35'! withFirstPost: anArchivePost ^ self new initialize firstPost: anArchivePost; yourself! ! !ArchiveRepository methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:16'! listing ^ ArchiveListing fromFileStream: self listingFile! ! !ArchiveRepository methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:16'! mailMessageForId: aNumberOrString | id fileName | id _ aNumberOrString asNumber. fileName _ self fullFileNameForId: id. (self emailsDir fileExists: fileName) ifFalse: [ | zipInterval zipMember | "Check to see if an already downloaded ZIP contains the file." zipInterval _ self zipIntervalForId: id. zipInterval isNil ifTrue: [ | zipList downloads | "Download ZIP filename". zipList _ self downloadZipsListForIds: { id }. zipList isEmptyOrNil ifFalse: [ "Download actual ZIP file." downloads _ self downloadZips: zipList. downloads isEmptyOrNil ifFalse: [ self error: 'Failed to download ZIP containing id: ', id asString. ]. ]. ]. "Try to extract member from already downloaded ZIP". zipMember _ self zipMemberForId: id. zipMember ifNotNil: [ "If the ZIP exists and contains the file, extract the file." zipMember extractToFileNamed: fileName. ]. ]. ^ MailUtil mailMessageFromFile: fileName ! ! !ArchiveRepository methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:16'! serverUrl ^ serverUrl! ! !ArchiveRepository methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:16'! serverUrl: aUrlOrString | newDirName | serverUrl _ aUrlOrString asUrl. newDirName _ self createDirsForUrl: serverUrl. repositoryDir _ repositoryDir directoryNamed: newDirName. ! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:16'! appendListingBytes: aByteArray | listingFile | listingFile _ self repositoryDir fileNamed: self listingFileName. listingFile binary. listingFile setToEnd. listingFile nextPutAll: aByteArray. listingFile close. ^ aByteArray ! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:16'! downloadListing "Download the BFAV listing from the server over HTTP. The download request uses If-Changed-Since and Range headers to only download the bytes added to the listing on the server since this client's last download of the listing file." | bytes numBytes | self repositoryDir ifNil: [self error: 'No repository directory has been defined.']. numBytes _ 0. "If we have never downloaded the listing before, then download the zipped listing first." (self listingFileExists) ifFalse: [(self zippedListingFileExists) ifFalse: [self downloadZippedListing. bytes _ self extractZippedListing. numBytes _ bytes size]]. "Download and append the difference between the server listing and the local listing." (bytes isEmptyOrNil not and: [self listingFileExists]) ifTrue: [ bytes _ bytes, self downloadListingDelta. bytes ifNotNil: [ numBytes _ bytes size. ]. (numBytes > 0) ifTrue: [ self appendListingBytes: bytes. ]]. ^ bytes! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:16'! downloadListingDelta "Download the BFAV listing from the server over HTTP. The download request uses the Range HTTP header to only download the bytes added to the listing on the server since this client's last download of the listing file." | numBytes response bytes | self listingFileExists ifFalse: [ ^ nil ]. numBytes _ self listingFile size. response _ self httpGet: self listingUrl withRange: numBytes asString, '-'. (response notNil and: [response isSuccessful]) ifTrue: [ bytes _ response bodyBytes. ]. ^ bytes! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:16'! downloadZippedListing "Download the BFAV listing from the server over HTTP. The download request uses If-Changed-Since and Range headers to only download the bytes added to the listing on the server since this client's last download of the listing file." | response zipBytes zipFile | self zippedListingFileExists ifTrue: [ self error: 'ZIP for BFAV listing already exists locally, so I''m not going to download it again.' ]. response _ self httpGet: self zippedListingUrl. (response notNil and: [response isSuccessful]) ifTrue: [ zipBytes _ response bodyBytes. (zipBytes isNil or: [zipBytes size = 1]) ifTrue: [ self error: 'No bytes available for BFAV listing ZIP.'. ]. zipFile _ self repositoryDir fileNamed: self zippedListingFileName. zipFile binary. zipFile nextPutAll: zipBytes. zipFile close. ]. ^ zipFile! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:22'! downloadZips: aListOfStrings "Downloads ZIP files from the server." | url response fn file downloads alreadyHere diff | aListOfStrings isEmptyOrNil ifTrue: [ ^ #() ]. downloads _ OrderedCollection new. alreadyHere _ self repositoryDir fileNames. aListOfStrings do: [ :name | fn _ name withBlanksTrimmed. ((alreadyHere includes: fn) not or: [ fn = 'latest.zip' ]) ifTrue: [ file _ self repositoryDir fileNamed: fn. url _ (self serverUrl asString, '/', fn) asUrl. response _ self httpGet: url. (response notNil and: [response isSuccessful]) ifTrue: [ file binary nextPutAll: response bodyBytes. file close. downloads add: fn. ]. ]. ]. diff _ (aListOfStrings difference: downloads) difference: alreadyHere. diff size > 0 ifTrue: [ self inform: 'Failed to download ', diff asString. self downloadZips: diff. ]. ^ downloads ! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:16'! downloadZipsListForIds: aListOfIds "Returns the server's list of ZIP files that span aListOfIds." | url response bytes file zipsList | aListOfIds ifNil: [ ^ nil ]. aListOfIds isEmpty ifTrue: [ ^ #() ]. url _ self emailFileZipsListUrlFor: aListOfIds. response _ self httpGet: url. (response notNil and: [response isSuccessful]) ifTrue: [ bytes _ response bodyBytes. ] ifFalse: [ self error: 'Failed to download list of zipped email files.' ]. bytes ifNil: [ ^ nil ]. self repositoryDir deleteFileNamed: 'zips.list' ifAbsent: []. file _ self repositoryDir fileNamed: 'zips.list'. file binary nextPutAll: bytes. file close. zipsList _ response body withBlanksTrimmed findTokens: Character lf. ^ zipsList ! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:16'! httpGet: aUrlOrString ^ self httpGet: aUrlOrString withRange: nil! ! !ArchiveRepository methodsFor: 'downloads' stamp: 'bkv 11/8/2003 12:16'! httpGet: aUrlOrString withRange: aRangeString | request response | [ request _ SptHTTPRequest new. request openGetTo: aUrlOrString asString; addHeader: 'Accept' value: '*/*'; isFollowRedirects: false. aRangeString isEmptyOrNil ifFalse: [ request addHeader: 'Range' value: 'bytes=', aRangeString. ]. request send; waitOnReady. response _ request lastResponse. ] on: Error do: [ :err | self inform: 'A error has occurred: ', err messageText, '. This has prevented a successful HTTP response.' ]. ^ response! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! attachmentsDirectoryForId: aNumberOrString ^ self repositoryDir directoryNamed: aNumberOrString asString, '-attachments'! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! attachmentsForId: aNumberOrString | attachmentDir attachmentFileNames | attachmentDir _ self attachmentsDirectoryForId: aNumberOrString. attachmentDir ifNil: [ ^ nil ]. attachmentFileNames _ attachmentDir fileNames. attachmentFileNames isEmptyOrNil ifTrue: [ attachmentFileNames _ self extractAndSaveAttachmentsForId: aNumberOrString ]. ^ attachmentFileNames! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! createDirsForUrl: aUrlOrString | url subDirNames currentDir | aUrlOrString asString isEmptyOrNil ifTrue: [ ^nil ]. url _ aUrlOrString asUrl. subDirNames _ { url authority }, url path. subDirNames _ subDirNames reject: [ :any | (any endsWith: 'txt') or: [ repositoryDir pathParts includes: any ]]. currentDir _ self repositoryDir. subDirNames do: [ :dName | currentDir assureExistenceOfPath: dName. currentDir _ currentDir directoryNamed: dName ]. ^ currentDir pathName! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! emailFileNames ^ self emailsDir fileNames collect: [ :fn | self repositoryDir fullNameFor: fn ]! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! emailsDir | dir | dir _ self repositoryDir directoryNamed: 'emails'. dir assureExistence. ^ dir! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! extractAndSaveAttachmentsForId: aNumberOrString | id mailMsg formattedParts atts attFileNames | id _ aNumberOrString asNumber. mailMsg _ self mailMessageForId: id. mailMsg ifNil: [ ^ nil ]. mailMsg fields isEmpty ifTrue: [ ^ #() ]. mailMsg body isMultipart ifFalse: [ ^ #() ]. formattedParts _ MailUtil parsePartsFor: mailMsg. (formattedParts isEmptyOrNil) ifTrue: [ ^ #() ]. atts _ MailUtil attachmentPartsFrom: formattedParts. atts isEmptyOrNil ifTrue: [ ^ #() ]. self emailsDir assureExistence. attFileNames _ OrderedCollection new. atts do: [ :part | | stream streamSize file fileSize sizeDiff | (part isKindOf: MailMessage) ifTrue: [ stream _ RWBinaryOrTextStream with: part body content. file _ self emailsDir fileNamed: (self emailsDir localNameFor: part name). ]. streamSize _ stream contents size. fileSize _ file contents size. "Don't unnecessarily append to an existing file" sizeDiff _ streamSize - fileSize. (sizeDiff >= 0) ifTrue: [ file nextPutAll: (stream contents copyFrom: (streamSize - sizeDiff) + 1 to: streamSize ). ]. stream close. file close. attFileNames add: file name. ]. ^ attFileNames ! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! fileExtension ^ '.eml'! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! fileNames ^ self repositoryDir fileNames collect: [ :fn | self repositoryDir fullNameFor: fn ]! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! fullFileNameForId: aNumberOrString ^ self emailsDir fullNameFor: (self localFileNameForId: aNumberOrString)! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! localFileNameForId: aNumberOrString ^ aNumberOrString asString, self fileExtension! ! !ArchiveRepository methodsFor: 'files' stamp: 'bkv 11/8/2003 12:16'! repositoryDir ^ repositoryDir! ! !ArchiveRepository methodsFor: 'initialization' stamp: 'bkv 11/8/2003 12:16'! baseDirName ^ 'email-file-repository'! ! !ArchiveRepository methodsFor: 'initialization' stamp: 'bkv 11/8/2003 12:16'! onDirectory: aDirectory "Set aDirectory as this repository's base directory." repositoryDir _ aDirectory directoryNamed: self baseDirName. repositoryDir assureExistence. ! ! !ArchiveRepository methodsFor: 'listing' stamp: 'bkv 11/8/2003 12:16'! listingFile ^ (self repositoryDir fileExists: self listingFileName) ifTrue: [ self repositoryDir readOnlyFileNamed: self listingFileName ] ifFalse: [ nil ]! ! !ArchiveRepository methodsFor: 'listing' stamp: 'bkv 11/8/2003 12:16'! listingFileExists ^ self repositoryDir fileExists: self listingFileName ! ! !ArchiveRepository methodsFor: 'listing' stamp: 'bkv 11/8/2003 12:16'! listingFileName ^ self repositoryDir fullNameFor: 'listing'! ! !ArchiveRepository methodsFor: 'listing' stamp: 'bkv 11/8/2003 12:16'! listingRows self listingFileExists ifFalse: [ self downloadListing ]. ^ self listing rows ! ! !ArchiveRepository methodsFor: 'testing' stamp: 'bkv 11/8/2003 12:16'! byteSize "Answer a (somewhat low) estimate of how much space I take up" " HttpEmailFileRepository allSubInstances detectSum: [ :ea | ea byteSize ] " | dataSize | dataSize _ self class instSize * 4. dataSize _ dataSize + 4. "repositoryDir" dataSize _ dataSize + self serverUrl asString size. ^ dataSize! ! !ArchiveRepository methodsFor: 'testing' stamp: 'bkv 11/8/2003 12:16'! size | fns | fns _ self fileNames. fns ifNil: [ ^ 0 ]. fns addAll: self emailFileNames. ^ fns size! ! !ArchiveRepository methodsFor: 'updates' stamp: 'bkv 11/8/2003 12:16'! loadEverything "Load all BFAV posts stored locally. Then load updates, if there are any." | listingRows | listingRows _ self listingRows. listingRows add: self loadUpdates. ^ listingRows ! ! !ArchiveRepository methodsFor: 'updates' stamp: 'bkv 11/8/2003 12:16'! loadUpdates | listingDelta | listingDelta _ self updateListing. ^ (listingDelta isEmptyOrNil) ifTrue: [ {} ] ifFalse: [ (ArchiveListing fromByteArray: listingDelta) rows ] ! ! !ArchiveRepository methodsFor: 'updates' stamp: 'bkv 11/8/2003 12:16'! updateListing "Updates the local copy of the BFAV listing. Returns the downloaded bytes." | downloadedBytes | downloadedBytes _ self downloadListing. ^ downloadedBytes! ! !ArchiveRepository methodsFor: 'urls' stamp: 'bkv 11/8/2003 12:16'! emailFileZipsListUrl ^ (self serverUrl asString, '/', 'getPosts.cgi') asUrl! ! !ArchiveRepository methodsFor: 'urls' stamp: 'bkv 11/8/2003 12:16'! emailFileZipsListUrlFor: aListOfIds | sortedIds url | sortedIds _ aListOfIds asSortedCollection: [ :a :b | a < b ]. url _ (self emailFileZipsListUrl asString, '?', 'from=', sortedIds first asString, '&', 'to=', sortedIds last asString) asUrl. ^ url! ! !ArchiveRepository methodsFor: 'urls' stamp: 'bkv 11/8/2003 12:16'! listingUrl ^ (self serverUrl asString, '/', 'listing') asUrl! ! !ArchiveRepository methodsFor: 'urls' stamp: 'bkv 11/8/2003 12:16'! zippedListingUrl ^ (self listingUrl asString, '.zip') asUrl! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! extractZippedListing self listingFileExists ifTrue: [ self error: 'Can''t extract BFAV listing file from this ZIP because the BFAV listing file already exists locally.' ]. self zipArchiveForListing extractMember: 'listing' toFileNamed: self listingFileName. ^ self listingFile binary contents! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! fileNameForZipInterval: anInterval ^ anInterval first asString, '-', anInterval last asString, '.zip' ! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! latestPostIds ^ self postIdsFromZip: self latestZip ! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! latestZip ^ self zipArchiveNamed: 'latest.zip' ! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! postIdsFromZip: aZipArchive ^ aZipArchive members collect: [ :zipMem | zipMem fileName asNumber. ]! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! startId "1.txt is a placeholder file." ^ 2 ! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zipArchiveForListing ^ self zipArchiveNamed: self zippedListingFileName! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zipArchiveNamed: aLocalFileName ^ ZipArchive new readFrom: (self repositoryDir fullNameFor: aLocalFileName) ! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zipFileNames ^ self fileNames select: [ :e | e endsWith: '.zip' ]! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zipIntervalForId: aNumberOrString | id interval | id _ aNumberOrString asNumber. interval _ self zipIntervals detect: [ :any | any includes: id ] ifNone: [ nil ]. ^ interval! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zipIntervals "Returns the list of Intervals covered by the downloaded ZIP files, sorted by last value." | intervals | intervals _ OrderedCollection new. self zipFileNames do: [ :e | | source | source _ e copyFrom: ((e lastIndexOf: $/) + 1) to: ((e lastIndexOf: $.)-1). (source = 'latest') ifTrue: [ | postIds | postIds _ self latestPostIds asSortedCollection. intervals add: (Interval from: postIds first to: postIds last). ] ifFalse: [ intervals add: source asInterval. ]. ]. ^ intervals asSortedCollection: [ :a : b | a last < b last ]! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zipMemberForId: aNumberOrString | id zipIntervals interval fileName zip memberName member | id _ aNumberOrString asNumber. zipIntervals _ self zipIntervals. interval _ zipIntervals detect: [ :any | any includes: id ] ifNone: [ nil ]. interval ifNil: [ ^ nil ]. interval = zipIntervals last ifTrue: [ fileName _ 'latest.zip' ] ifFalse: [ fileName _ self fileNameForZipInterval: interval. ]. zip _ self zipArchiveNamed: fileName. memberName _ id asString, '.eml'. member _ zip members detect: [ :zipMember | zipMember fileName = memberName ] ifNone: [ nil ]. ^ member ! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zippedListingFile | fn | fn _ self zippedListingFileName. ^ (self repositoryDir fileExists: fn) ifTrue: [ self repositoryDir readOnlyFileNamed: fn ] ifFalse: [ nil ]! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zippedListingFileExists ^ self repositoryDir fileExists: self zippedListingFileName! ! !ArchiveRepository methodsFor: 'zips' stamp: 'bkv 11/8/2003 12:16'! zippedListingFileName ^ self repositoryDir fullNameFor: 'listing.zip'! ! !ArchiveRepository class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:16'! sqFoundationRepository "HttpEmailFileRepository sqFoundationRepository" ^ self withServerUrl: 'http://bfav.squeakfoundation.org' asUrl ! ! !ArchiveRepository class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:16'! withServerUrl: aUrlOrString ^ self withServerUrl: aUrlOrString asUrl onDirectory: FileDirectory default. ! ! !ArchiveRepository class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:16'! withServerUrl: aUrlOrString onDirectory: aDirectory ^ self new onDirectory: aDirectory; serverUrl: aUrlOrString asUrl; yourself! ! !MailUtil class methodsFor: 'mail-message-utilities' stamp: 'bkv 9/4/2003 08:28'! attachmentPartsFrom: aMailMessageAtomicParts aMailMessageAtomicParts isEmptyOrNil ifTrue: [ ^ #() ]. ^ (aMailMessageAtomicParts select: [ :mailMsg | mailMsg notNil and: [ 'application/*' match: mailMsg body contentType ]]) reject: [ :attachPart | attachPart name isEmptyOrNil ]! ! !MailUtil 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 ! ! !MailUtil class methodsFor: 'mail-message-utilities' stamp: 'bkv 9/6/2003 19:11'! mailMessageFromFile: aFileName | file mailMsg | file _ (CrLfFileStream readOnlyFileNamed: aFileName) text. mailMsg _ MailMessage from: file contents. ^ mailMsg! ! !MailUtil class methodsFor: 'mail-message-utilities' stamp: 'bkv 11/6/2003 19:18'! nameAndEmailAddressFromLine: aString | fromLine emailList email nameTokens fromName | aString ifNil: [ ^ nil ]. fromLine _ aString. [ emailList _ MailAddressParser addressesIn: aString. ] 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 isEmptyOrNil) ifFalse: [ email _ emailList first ]. email ifNotNil: [ fromName _ (aString copyUpTo: $<) withBlanksTrimmed. ]. name ifNotNil: [ ((fromName beginsWith: '"') and: [fromName endsWith: '"']) ifTrue: [ nameTokens _ fromName findTokens: $". nameTokens isEmptyOrNil ifFalse: [ fromName _ nameTokens first. ]]]. ^ { fromName. email. } ! ! !MailUtil class methodsFor: 'mail-message-utilities' stamp: 'bkv 6/1/2003 15:15'! parsePartsFor: aMailMessage ^ self collectPartsFrom: aMailMessage. ! ! !MailUtil 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 ]]! ! !MailUtil 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' ]]].! ! !PatchArchive methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:19'! archivePostGroups "Returns this BugFixArchive's list of ArchivePosts, grouped by topic and sorted in descending order by most-recent-post in each group." | sortedGroups | sortedGroups _ topicGroups values asSortedCollection: [ :groupA :groupB | groupA mostRecentPost id > groupB mostRecentPost id ]. ^ sortedGroups ! ! !PatchArchive methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:19'! archivePosts ^ archivePosts ! ! !PatchArchive methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:19'! name ^ (self class registry keyForIdentity: self) ifNil: [ 'unnamed' ]! ! !PatchArchive methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:19'! repository ^ repository! ! !PatchArchive methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:19'! repository: aRepository self repository ifNotNil: [ self error: 'This archive already has a repository.' ]. repository _ aRepository.! ! !PatchArchive methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:19'! serverUrl self repository ifNil: [ ^ nil ]. ^ self repository serverUrl! ! !PatchArchive methodsFor: 'accessing' stamp: 'bkv 11/8/2003 12:19'! topics ^ topicGroups keys copy! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! announcementPosts ^ self archivePosts select: [ :post | post isAnnouncement ] ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! approvedArchivePostGroups self archivePostGroups ifNil: [ ^ nil ]. ^ (self archivePostGroups select: [ :every | every isMarkedAsApproved ]) ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! archivePostsSortedByDate "Archive posts grouped by topic and then sorted in descending order by date." ^ self archivePosts asSortedCollection: self dateDescendingSortBlock! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! bugPosts ^ self archivePosts select: [ :post | post isBug ] ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! closedArchivePostGroups self archivePostGroups ifNil: [ ^ nil ]. ^ (self archivePostGroups select: [ :every | every isMarkedAsClosed ]) ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! enhancementPosts ^ self archivePosts select: [ :post | post isEnhancement ] ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! fixPosts ^ self archivePosts select: [ :post | post isFix ] ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! goodiePosts ^ self archivePosts select: [ :post | post isGoodie ] ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! openArchivePostGroups | closed | closed _ self closedArchivePostGroups. self archivePostGroups ifNil: [ ^ nil ]. ^ self archivePostGroups reject: [ :any | closed includes: any ] ! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsForMonth: aMonth "This assumes a generic Month object ( which in Squeak, specifies the year as well )." ^ self archivePosts select: [ :post | post monthMatches: aMonth ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsForMonth: aMonth andYear: aNumber ^ self archivePosts select: [ :post | post monthMatches: aMonth andYearMatches: aNumber ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsForYear: aNumber ^ self archivePosts select: [ :post | post yearMatches: aNumber ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsWithAuthorEmail: aString ^ self archivePosts select: [ :post | post authorEmailMatches: aString ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsWithAuthorName: aString ^ self archivePosts select: [ :post | post authorNameMatches: aString ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsWithAuthorNameOrEmail: aString ^ self archivePosts select: [ :post | post authorNameOrEmailMatches: aString ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsWithBodyMatching: aString ^ self archivePosts select: [ :post | post bodyMatches: aString ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsWithTitleMatching: aString ^ self archivePosts select: [ :post | post titleMatches: aString ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! postsWithTitleOrBodyMatching: aString ^ self archivePosts select: [ :post | post titleOrBodyMatches: aString ]! ! !PatchArchive methodsFor: 'enumerating' stamp: 'bkv 11/8/2003 12:19'! updateStreamArchivePostGroups self archivePostGroups ifNil: [ ^ nil ]. ^ (self archivePostGroups select: [ :every | every isMarkedAsUpdate ]) ! ! !PatchArchive methodsFor: 'initialization' stamp: 'bkv 11/8/2003 12:19'! initialize archivePosts _ SortedCollection sortBlock: self idDescendingSortBlock. topicGroups _ Dictionary new. ! ! !PatchArchive methodsFor: 'modifying' stamp: 'bkv 11/8/2003 12:19'! addArchivePost: aPost | groupTopic group | aPost ifNil: [ ^ nil ]. "We only archive aPost if it is a [ANN],[BUG],[ENH],[FIX] or [GOODIE] post" aPost isCanonicalType ifFalse: [ ^ nil ]. groupTopic _ aPost topic. (groupTopic isEmptyOrNil) ifFalse: [ self archivePosts add: aPost ]. group _ topicGroups at: groupTopic ifAbsent: [ nil ]. group isNil ifTrue: [ topicGroups at: groupTopic put: (ArchivePostGroup withFirstPost: aPost) ] ifFalse: [ group addPost: aPost. ]. ^ aPost ! ! !PatchArchive methodsFor: 'modifying' stamp: 'bkv 11/8/2003 12:19'! removeArchivePost: aPost archivePosts remove: aPost. ! ! !PatchArchive methodsFor: 'printing' stamp: 'bkv 11/8/2003 12:19'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self name; nextPut: $).! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! attachmentsDirectoryForId: aNumberOrString self repository ifNil: [ ^ nil ]. ^ self repository attachmentsDirectoryForId: aNumberOrString! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! attachmentsForId: aNumberOrString self repository ifNil: [ ^ nil ]. ^ self repository attachmentsForId: aNumberOrString! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 20:31'! byteSize "Answer a (somewhat low) estimate of how much space I take up" " PatchArchive allSubInstances detectSum: [ :ea | ea byteSize ] " | dataSize | dataSize _ self class instSize * 4. dataSize _ dataSize + self repository byteSize. dataSize _ dataSize + (self archivePosts detectSum: [ :post | post byteSize ]). dataSize _ dataSize + self archivePostGroups size * 4. ^ dataSize! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! fullFileNameForId: aNumberOrString self repository ifNil: [ ^ nil ]. ^ self repository fullFileNameForId: aNumberOrString! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! mailMessageForId: aNumberOrString self repository ifNil: [ ^ nil ]. ^ self repository mailMessageForId: aNumberOrString! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! monthsRepresentedForYear: aNumber ^((self postsForYear: aNumber) collect: [ :ea | ea dateSent month ]) asSet asSortedCollection! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! size ^ self archivePosts size! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! sourceFileForId: aNumberOrString self repository ifNil: [ ^ nil ]. ^ self repository sourceFileForId: aNumberOrString! ! !PatchArchive methodsFor: 'services' stamp: 'bkv 11/8/2003 12:19'! 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 ]! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! dateAscendingSortBlock ^[ :a :b | (a dateSent < b dateSent) or: [ b dateSent isNil ]] copy fixTemps! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! dateDescendingSortBlock ^[ :a :b | (a dateSent > b dateSent) or: [ b dateSent isNil ]] copy fixTemps! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! defaultSortBlock ^self idDescendingSortBlock! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! idAscendingSortBlock ^[ :a :b | a id < b id ] copy fixTemps! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! idDescendingSortBlock ^[ :a :b | a id > b id ] copy fixTemps! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! sortByDateAscending archivePosts sortBlock: self dateAscendingSortBlock! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! sortByDateDescending archivePosts sortBlock: self dateDescendingSortBlock! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! sortByIdAscending archivePosts sortBlock: self idAscendingSortBlock! ! !PatchArchive methodsFor: 'sorting' stamp: 'bkv 11/8/2003 12:19'! sortByIdDescending archivePosts sortBlock: self idDescendingSortBlock! ! !PatchArchive methodsFor: 'testing' stamp: 'bkv 11/8/2003 12:19'! isUpdatable ^ self repository notNil! ! !PatchArchive methodsFor: 'updates' stamp: 'bkv 11/8/2003 12:19'! listChanged "Notify my dependents that my contents have changed in some important way" self changed: #listChanged! ! !PatchArchive methodsFor: 'updates' stamp: 'bkv 11/8/2003 12:19'! loadEverything "Returns the list of all ArchivePost objects loaded into this BugFixArchive after its repository updates itself." | listingRows posts | self repository ifNil: [ ^ nil ]. listingRows _ self repository loadEverything. posts _ listingRows collect: [ :listingRow | ArchivePost archive: self listingRow: listingRow ]. posts do: [ :post | self addArchivePost: post ]. self listChanged. ^ posts! ! !PatchArchive methodsFor: 'updates' stamp: 'bkv 11/8/2003 12:19'! loadUpdates "Returns the list of new ArchivePost objects loaded into this BugFixArchive after its repository updates itself." | listingRows posts | self repository ifNil: [ ^ nil ]. listingRows _ self repository loadUpdates. posts _ listingRows collect: [ :listingRow | ArchivePost archive: self listingRow: listingRow ]. posts do: [ :post | self addArchivePost: post ]. self listChanged. ^ posts! ! !PatchArchive methodsFor: 'validation' stamp: 'bkv 11/8/2003 12:19'! validate self error: 'Implement me!!' ! ! !PatchArchive class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:20'! defaultArchive "PatchArchive defaultArchive" ^ self sqFoundationArchive! ! !PatchArchive class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:19'! new ^ super new initialize! ! !PatchArchive class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:20'! sqFoundationArchive "PatchArchive sqFoundationArchive" ^ self named: #sqFoundationArchive ifAbsentPut: [ self withRepository: ArchiveRepository sqFoundationRepository. ]! ! !PatchArchive class methodsFor: 'instance creation' stamp: 'bkv 11/8/2003 12:20'! withRepository: aRepository | archive | archive _ self new initialize repository: aRepository. ^ archive! ! !PatchArchive class methodsFor: 'registry' stamp: 'bkv 11/8/2003 12:19'! clearRegistry "PatchArchive clearRegistry" "Initialize my registry, thus forgetting all the registered BugFixArchives" ^ Registry _ WeakValueDictionary new! ! !PatchArchive class methodsFor: 'registry' stamp: 'bkv 11/8/2003 12:19'! forgetArchiveNamed: aSymbol "Remove the PatchArchive named aSymbol from my registry, if there is such an entry." ^ self registry removeKey: aSymbol ifAbsent: []! ! !PatchArchive class methodsFor: 'registry' stamp: 'bkv 11/8/2003 12:19'! named: aSymbol ifAbsentPut: aBlock "Answer the PatchArchive named aSymbol. If it doesn't exist, or has been garbage collected, register the value of aBlock under aSymbol and answer that." | retval | retval _ self registry at: aSymbol ifAbsentPut: [ nil ]. ^ retval ifNil: [ self registry at: aSymbol put: aBlock value ]. ! ! !PatchArchive class methodsFor: 'registry' stamp: 'bkv 11/8/2003 12:20'! registry "Answer my registry, which is a Dictionary of name->PatchArchive" ^ Registry ifNil: [ self clearRegistry ].! ! PatchArchive class removeSelector: #defaultLoadFilterSelectors! MailUtil class removeSelector: #mimeDocumentFromUrl:! !MailUtil reorganize! ('as yet unclassified') ! !ArchivePostGroup reorganize! ('initialization' initialize printTopicOn: 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 maxId mostRecentDate mostRecentPost numberOfReviews postDates size sizeMatches: titleMatches: titleOrBodyMatches: yearMatches:) ('queries about type' isAnnouncement isBug isBugAndFix isBugAndNotFix isBugOnly isEnhancement isFix isFixAndNotBug isGoodie) ('queries about status' hasNoStatus isMarkedAsApproved isMarkedAsClosed isMarkedAsUpdate) ! ArchivePost class removeSelector: #findTokensInListingRow:! ArchivePost class removeSelector: #indexesForUnEscapedListingCharacter:! ArchivePost class removeSelector: #indexesForUnEscapedListingRow:! ArchivePost initialize! ArchivePost class removeSelector: #maskForPassesSLint! ArchivePost class removeSelector: #unEscapeListingRow:! !ArchivePost class reorganize! ('accessing' canonicalQaFlags canonicalQaTags canonicalStatusFlags canonicalStatusTags canonicalTypeFlags canonicalTypeTags canonicalTypes flagForQaTag: flagForStatusTag: flagForTypeTag: tagForQaFlag: tagForStatusFlag: tagQaMap tagStatusMap tagTypeMap) ('parsing' parseReviewStepsMaskFromTitle:) ('bit masks for review steps' maskForDocumented maskForReviewed maskForSLint maskForSUnitTests maskForSmall maskForTested) ('bit masks for status tags' maskForApproved maskForClosed maskForUpdate) ('bit masks for type tags' maskForAllTypesCombined maskForAnnouncement maskForBug maskForEnhancement maskForFix maskForGoodie) ('class initialization' initialize initializeTagQaMap initializeTagStatusMap initializeTagTypeMap) ('instance creation' archive:id: archive:listingRow:) ('type tags' tagForAnnouncement tagForBug tagForEnhancement tagForFix tagForGoodie) ('review step tags' tagForHasBeenDocumented tagForHasBeenReviewed tagForHasBeenTested tagForHasSUnitTests tagForIsSmall tagForPassesSLint) ('status tags' tagForHasBecomeAnUpdate tagForHasBeenApproved tagForHasBeenClosed) ('flags' symbolForHasBecomeAnUpdate symbolForHasBeenApproved symbolForHasBeenClosed symbolForHasBeenDocumented symbolForHasBeenReviewed symbolForHasBeenTested symbolForHasSUnitTests symbolForIsAnnouncement symbolForIsBug symbolForIsEnhancement symbolForIsFix symbolForIsGoodie symbolForIsSmall symbolForPassesSLint) ('utilities' harvestingTagSpecs parseTagsFromString:) ! ArchivePost removeSelector: #describe:withBoldLabel:on:! ArchivePost removeSelector: #fullDescription! !ArchivePost reorganize! ('accessing' archive archive: authorEmail authorEmail: authorName authorName: dateSent dateSent: displayLabel displayLabel: flags id id: qaFlags reviewStepsMask reviewStepsMask: statusFlags statusMask statusMask: title title: topic typeFlags typeMask typeMask: updateStreamNumbers) ('comparing' = hash) ('files' attachments attachmentsDirectory hasAttachments) ('initialization' initialize) ('mail headers' authorEmailFromMailMessage authorNameFromMailMessage body comments dateSentFromMailMessage titleFromMailMessage) ('printing' groupDisplayLabel printGroupDisplayLabelOn: printOn: printString) ('queries' authorEmailMatches: authorNameMatches: authorNameOrEmailMatches: bodyMatches: byteSize isBefore:andAfter: monthMatches: monthMatches:andYearMatches: size titleMatches: titleOrBodyMatches: yearMatches:) ('review-step testing' isMarkedAsHasBeenDocumented isMarkedAsHasBeenReviewed isMarkedAsHasBeenTested isMarkedAsHasSUnitTests isMarkedAsPassesSLint isMarkedAsSmall) ('status testing' hasNoStatus isMarkedAsApproved isMarkedAsClosed isMarkedAsUpdate) ('services' addQaTag: asMailMessage rawAttachments removeQaTag:) ('title parsing' flagsFromTags: flagsFromTags:usingSelector: parseCommentsFromTitle parseFlagsFromTitle parseReviewStepsMaskFromTitle parseTagsFromTitle parseUpdateStreamNumbersFromTitle qaFlagsFromTags: statusFlagsFromTags: topicContentFrom: typeFlagsFromTags: updateStreamNumbersFromTags:) ('title tags' canonicalQaFlags canonicalQaTags canonicalStatusFlags canonicalStatusTags canonicalTypeFlags canonicalTypeTags canonicalTypes flagForQaTag: flagForStatusTag: qaTags statusTags tagForQaFlag: tagForType:) ('types testing' isAnnouncement isBug isBugAndFix isBugAndNotFix isBugOnly isCanonicalType isEnhancement isFix isFixAndNotBug isGoodie typeTags) ! ArchiveListing class removeSelector: #from:! ArchiveListing class removeSelector: #maxElements! ArchiveListing class removeSelector: #rowsFromListingBytes:! !ArchiveListing class reorganize! ('instance creation' fromByteArray: fromFileNamed: fromFileStream:) ('parsing' escapeListingRowElement: findTokensInListingRow: indexesForUnEscapedListingRow: listingRowFromString: numListingRowElements rowsFromByteArray: rowsFromFileStream: rowsFromString: unEscapeListingRowElement:) !