'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5205] on 20 May 2003 at 3:48:07 pm'! "Change Set: BugFixArchive-Model-bkv Date: 10 May 2003 Author: Brent Vukmer A 'living' local copy of the Bug Fixes Archive ( currently at http://swiki.gsug.org/sqfixes ). A good chunk o' HTML screen-scraping goes into loading the posts from the archive, so creating a BugFixArchive object is pretty slow. This class provides the domain model for BugFixArchiveViewer.. and I hope other clients, such as the StarBrowser, eventually."! Object subclass: #ArchivePost instanceVariableNames: 'archive title types authorName authorEmail dateSent text parentPost postUrl attachments attachmentDir groupDisplayLabel ' classVariableNames: 'TagTypeMap ' poolDictionaries: '' category: 'BugFixArchive-Model'! !ArchivePost commentStamp: 'bkv 5/11/2003 16:54' prior: 0! A 'living' local copy of a post to the Bug Fixes Archive ( currently at http://swiki.gsug.org/sqfixes ). A good chunk o' HTML screen-scraping goes into initializing an ArchivePost object, so I recommend that one usually access ArchivePost objects by doing: BugFixArchive default archivePosts. You can create an ArchivePost object by doing: ArchivePost withChangesetUrl: aUrlThatPointsToArchiveChangeset. TBD: Properly format dateSent iVar as Date object ( currently just a String ). Enable the ArchivePost class to create a new instance from a mail message. Enable ArchivePost object to post itself to an HTTP URL. ! Object subclass: #ArchivePostGroup instanceVariableNames: 'topic firstPost replies ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! Object subclass: #BugFixArchive instanceVariableNames: 'aggregators mailDbs urls archivePosts repositoryDir ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-Model'! !BugFixArchive commentStamp: 'bkv 5/10/2003 15:58' prior: 0! A 'living' local copy of the Bug Fixes Archive ( currently at http://swiki.gsug.org/sqfixes ). A good chunk o' HTML screen-scraping goes into loading the posts from the archive, so creating a BugFixArchive object is pretty slow -- even using pre-loaded URLs to stock the local copy. I recommend that you use the following to get a copy of the BugFixArchive: BugFixArchive default. You can query a BugFixArchive for specific types of posts: BugFixArchive default fixPosts. BugFixArchive default enhancementPosts. This class provides the domain model for BugFixArchiveViewer right now.. and I hope other clients, such as the StarBrowser, eventually.! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 14:48'! isAnnouncement ^self types includes: #ANN! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 14:51'! isBug ^self types includes: #BUG! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 13:44'! isBugAndFix ^self isBug and: [ self isFix ]! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 14:35'! isBugAndNotFix ^self isBug and: [ self isFix not ]! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 15:47'! isBugOnly ^(self isBug) and: [ (self types reject: [ :a | a == #BUG ]) isEmpty ]! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 17:22'! isChildOf: anArchivePost ^(self parentPost notNil) and: [ self parentPost postUrl = anArchivePost postUrl ]! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 14:48'! isEnhancement ^self types includes: #ENH! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 14:51'! isFix ^self types includes: #FIX! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 14:36'! isFixAndNotBug ^self isFix and: [ self isBug not ]! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 14:48'! isGoodie ^self types includes: #GOODIE! ! !ArchivePost methodsFor: 'testing' stamp: 'bkv 5/13/2003 17:24'! isParentOf: anArchivePost ^anArchivePost isChildOf: self! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/18/2003 21:56'! archive ^archive! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/18/2003 21:56'! archive: aBugFixArchive archive _ aBugFixArchive! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/18/2003 22:00'! attachmentDir "Returns the full name of the directory to which this post should save attachments." | dir subDirName | self archive isNil ifTrue: [ ^nil ]. dir _ self archive repositoryDir. subDirName _ (self postUrl path last copyUpTo: '.'), '-', 'attachments'. (dir directoryExists: subDirName) ifFalse: [ dir createDirectory: subDirName ]. ^dir directoryNamed: subDirName ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/16/2003 16:41'! attachmentUrls ^attachmentUrls! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:14'! authorEmail ^authorEmail! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:14'! authorEmail: aString authorEmail _ aString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:13'! authorName ^authorName! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:13'! authorName: aString authorName _ 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/15/2003 22:32'! groupDisplayLabel ^groupDisplayLabel! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:16'! parentPost ^parentPost! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:16'! parentPost: anArchivePost parentPost _ anArchivePost ! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/11/2003 16:36'! postUrl ^postUrl! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/11/2003 16:36'! postUrl: aUrlOrString postUrl _ aUrlOrString asUrl! ! !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 5/9/2003 12:12'! title: aString title _ aString! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/13/2003 14:46'! types ^types! ! !ArchivePost methodsFor: 'accessing' stamp: 'bkv 5/13/2003 14:46'! types: aCollection types _ aCollection! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 5/16/2003 16:45'! canonicalTags ^self class canonicalTags ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 5/16/2003 16:45'! canonicalTypes ^self class canonicalTypes ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 5/16/2003 16:56'! initialize self types ifNil: [ self types: OrderedCollection new ]. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 5/16/2003 07:51'! initializeGroupDisplayLabel "This method really only needs to be called when adding an ArchivePost to an ArchivePostGroup. See ArchivePostGroup>>addReply:" groupDisplayLabel _ String streamContents: [ :stream | self printGroupDisplayLabelOn: stream ]. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 5/13/2003 15:33'! initializeTypes | theseTypes | theseTypes _ self parseTagsFromTitle collect: [ :tag | self class getTypeForTag: tag ]. theseTypes _ theseTypes reject: [ :every | every isNil ]. self types: theseTypes. ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 5/13/2003 14:30'! parseTagsFromTitle | 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 5/13/2003 14:22'! tagForType: aSymbol ^self tagTypeMap keyAtValue: aSymbol ! ! !ArchivePost methodsFor: 'initialization' stamp: 'bkv 5/13/2003 13:36'! tagTypeMap ^self class tagTypeMap! ! !ArchivePost methodsFor: 'mail' stamp: 'bkv 5/10/2003 14:24'! mailServiceProvider | provider | provider _ (Smalltalk at: #MailSender). provider isNil ifTrue: [ ^nil ]. ^provider default ! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 5/13/2003 16:50'! adHocTitle "Return a title for this post as if it were not yet posted to the archive." self title isNil ifTrue: [ ^String streamContents: [ :stream | self printOn: stream ]]. ^self title! ! !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 5/18/2003 21:53'! downloadFileName self postUrl ifNil: [ ^nil ]. self postUrl path isEmpty ifTrue: [ ^nil ]. ^self postUrl path last! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 5/13/2003 16:41'! 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: [self postCommentViaEmailTo: authorEmail ]) do: [s nextPutAll: authorName ]; cr]. self dateSent isEmptyOrNil ifTrue: [self describe: '' withBoldLabel: 'Date Posted: ' on: s] ifFalse: [self describe: self dateSent 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 5/15/2003 22:57'! printGroupDisplayLabelOn: aStream | comments leftParen rightParen | ((leftParen _ (self title indexOf: $()) > 0 and: [ (rightParen _ (self title indexOf: $))) > 0 ]) ifTrue: [ comments _ self title copyFrom: leftParen to: rightParen ]. aStream nextPutAll: authorName. aStream nextPut: Character space. aStream nextPutAll: self authorEmail. aStream nextPut: $(. aStream nextPutAll: self date asString. aStream nextPut: $). aStream nextPut: Character space. comments ifNotNil: [ aStream nextPutAll: comments ]. ^aStream ! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 5/16/2003 17:04'! printOn: aStream ^aStream nextPutAll: self title! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 5/10/2003 14:33'! printString ^self title! ! !ArchivePost methodsFor: 'printing' stamp: 'bkv 5/9/2003 20:50'! tagForType self isFix ifTrue: [ ^'[FIX]' ]. self isEnhancement ifTrue: [ ^'[ENH]' ]. ! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 5/16/2003 16:58'! loadDetails self error: 'Implement me using a call to a downloader utility'! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 5/16/2003 16:58'! loadUpdate "Just re-load everything." self error: 'Implement me'.! ! !ArchivePost methodsFor: 'services' stamp: 'bkv 5/16/2003 16:57'! reload self error: 'Implement me using downloader'! ! !ArchivePost methodsFor: ' mail' stamp: 'bkv 5/10/2003 14:24'! postCommentViaEmail self postCommentViaEmailTo: 'squeak-dev@lists.squeakfoundation.org'. ! ! !ArchivePost methodsFor: ' mail' stamp: 'bkv 5/16/2003 16:50'! postCommentViaEmailTo: aStringEmailAddress | aTitle parensComments messageStrm | (aTitle _ self title) isNil ifTrue: [ title _ self adHocTitle ]. aTitle isNil ifTrue: [ aTitle _ '' ]. parensComments _ parensComments, 'Put harvesting tags and summary comments inside these parens )'. "Prepare the message" messageStrm _ WriteStream on: (String new: 1500). messageStrm nextPutAll: 'From: '; nextPutAll: MailSender userName; cr; nextPutAll: 'To: ', aStringEmailAddress; cr; nextPutAll: 'Subject: '; nextPutAll: aTitle; nextPutAll: parensComments; cr;cr; nextPutAll: 'See the Swiki (http://minnow.cc.gatech.edu/squeak/3103) for guidelines on commenting on fixes and enhancements.'; cr;cr; nextPutAll: 'Before you press ''send message'', please check your summary comments on the subject line (inside the single set of parens) to see that you have included the appropriate harvesting tags:'; cr;tab; nextPutAll:'[cd] Changes documented; reasoning is given that explains every change made.'; cr;tab; nextPutAll: '[er] Externally reviewed, design + code, by someone quite knowledgeable about the package, other than the author.'; cr;tab; nextPutAll: '[et] Externally tested. Import into a fresh image; generally making sure it does not break anything that uses it; run relevant existing SUnit tests.'; cr;tab; nextPutAll: '[sl] SLint approved. You do not have to do what SLint says -- sometimes it is wrong -- but have a good reason why not.'; cr;tab; nextPutAll:'[sm] Small; changesets should be under 10k.'; cr;tab; nextPutAll: '[su] Covered by and passes SUnit tests, either included or external. Included tests should be described, and external tests should be pointed to.'; cr;cr. self mailServiceProvider sendMailMessage: (MailMessage from: messageStrm contents). ! ! !ArchivePost class methodsFor: 'instance creation' stamp: 'bkv 5/18/2003 22:43'! withMailMessage: aMailMessage "ArchivePost withMailMessage: 'http://swiki.gsug.org:8080/sqfixes/2627.txt' asUrl asMailMessage" | post aName fromLine emailList email body | post _ self new title: aMailMessage subject; yourself. "Assume that a space in the From: field indicates text that should be ignored by the parser" fromLine _ aMailMessage from copyUpTo: Character space. emailList _ MailAddressParser addressesIn: fromLine. (emailList notEmpty) ifTrue: [ email _ emailList first ]. email ifNotNil: [ aName _ (aMailMessage from copyUpTo: (aMailMessage from findString: email)) withBlanksTrimmed. ]. post authorEmail: email. post authorName: aName. post dateSent: aMailMessage date asDate. "Should we to filter out MIME attachments here & save 'em to file, or defer that until later?" body _ aMailMessage body content. post text: body. post initializeTypes. ^post ! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 5/16/2003 16:45'! canonicalTags ^self tagTypeMap keys! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 5/16/2003 16:45'! canonicalTypes ^self tagTypeMap values! ! !ArchivePost class methodsFor: 'accessing' stamp: 'bkv 5/11/2003 18:52'! tagTypeMap TagTypeMap isNil ifTrue: [ self initializeTagTypeMap ]. ^TagTypeMap! ! !ArchivePost class methodsFor: 'class initialization' stamp: 'bkv 5/11/2003 18:51'! initialize self initializeTagTypeMap.! ! !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: 'utilities' stamp: 'bkv 5/11/2003 18:53'! getTypeForTag: aString ^self tagTypeMap at: aString ifAbsent: [ nil ] ! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 5/12/2003 15:59'! parseArchiveNumberFromUri: aString (('*.attachments' match: aString) or: [ '*.html' match: aString]) ifTrue: [ ^(aString copyUpTo: $.) asInteger ]. ^nil! ! !ArchivePost class methodsFor: 'utilities' stamp: 'bkv 5/12/2003 16:04'! parseArchiveNumberFromUrl: urlOrString "ArchivePost parseArchiveNumberFromUrl: 'http://swiki.gsug.org:8080/sqfixes/3281.html' " "ArchivePost parseArchiveNumberFromUrl: 'http://swiki.gsug.org:8080/sqfixes/3281.attachments/DoOneCycleNowFix-nk.cs.gz' " | parseResult | (urlOrString asUrl path) do:[ :uriElement | parseResult _ self parseArchiveNumberFromUri: uriElement. parseResult ifNotNil: [ ^parseResult ]]. ^parseResult! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 5/16/2003 08:28'! initialize replies _ OrderedCollection new. ! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 5/15/2003 22:59'! initializeTopic topic _ String streamContents: [ :stream | self printTopicOn: stream ].! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 5/15/2003 23:02'! printTopicOn: aStream | content | content _ self topicContentFrom: self firstPost title. aStream nextPutAll: content. aStream nextPut: Character space. aStream nextPut: $(. aStream nextPutAll: self firstPost date asString. aStream nextPut: $). ^ aStream! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 5/15/2003 23:01'! topicContentFrom: aString | content parenIndex | ((parenIndex _ aString indexOf: $() > 0) ifTrue: [ content _ aString copyFrom: 1 to: (parenIndex - 1) ]. ^content! ! !ArchivePostGroup methodsFor: 'initialization' stamp: 'bkv 5/15/2003 23:03'! topicContentMatchesPost: anArchivePost ^(self topicContentFrom: self firstPost title) = (self topicContentFrom: anArchivePost title)! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/16/2003 16:43'! addReply: anArchivePost "Not sure about raising an error here. For now just do nothing if anArchivePost doesn't match the firstPost's topic." ( self topicContentMatchesPost: anArchivePost ) ifTrue: [ anArchivePost initializeGroupDisplayLabel. anArchivePost parentPost: self firstPost. self replies add: anArchivePost ].! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/16/2003 08:50'! allPosts | posts | posts _ OrderedCollection new add: self firstPost; yourself. posts addAll: self replies. ^posts! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/15/2003 22:20'! firstPost ^firstPost! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/16/2003 08:31'! firstPost: anArchivePost "If the topic is already set, don't set a first post that doesn't match the topic." self topic ifNotNil: [ (self topicContentMatchesPost: anArchivePost) ifFalse: [ ^ self ]]. firstPost _ anArchivePost.! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/16/2003 08:59'! groupIndexForPost: anArchivePost ^self allPosts indexOf: anArchivePost! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/15/2003 22:25'! replies ^replies copy! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/15/2003 22:39'! topic ^topic ! ! !ArchivePostGroup methodsFor: 'accessing' stamp: 'bkv 5/16/2003 08:28'! topic: aString "Only set the topic we do not have a firstPost." self topic ifNil: [ self firstPost ifNil: [ topic _ aString ]]. ! ! !ArchivePostGroup class methodsFor: 'instance creation' stamp: 'bkv 5/15/2003 22:21'! withFirstPost: anArchivePost self new firstPost: anArchivePost; initialize.! ! !ArchivePostGroup class methodsFor: 'instance creation' stamp: 'bkv 5/16/2003 08:29'! withTopic: aString ^self new topic: aString; initialize; yourself! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/19/2003 14:23'! addAggregator: anArchivePostAggregator ( aggregators includes: anArchivePostAggregator ) ifFalse: [ aggregators add: anArchivePostAggregator ].! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/18/2003 22:03'! addArchivePost: aPost aPost archive: self. archivePosts add: aPost.! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:17'! addMailDb: aMailDB mailDbs add: aMailDB! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:16'! archivePosts ^archivePosts copy! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/9/2003 12:22'! archivePosts: aListOfPosts archivePosts _ aListOfPosts! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:16'! mailDbs ^mailDbs copy! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:16'! mailDbs: aCollection mailDbs _ aCollection! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/19/2003 14:24'! removeAggregator: anArchivePostAggregator aggregators remove: anArchivePostAggregator ifAbsent: [].! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:16'! removeArchivePost: aPost archivePosts remove: aPost.! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:17'! removeMailDb: aMailDB mailDbs remove: aMailDB! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/18/2003 21:55'! repositoryDir ^repositoryDir! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/18/2003 21:55'! repositoryDir: aDirectory repositoryDir _ aDirectory! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:15'! urls ^urls ! ! !BugFixArchive methodsFor: 'accessing' stamp: 'bkv 5/16/2003 17:15'! urls: aCollection urls _ aCollection! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/12/2003 16:44'! announcementPosts ^self archivePosts select: [ :post | post isAnnouncement ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/12/2003 16:43'! bugPosts ^self archivePosts select: [ :post | post isBug ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/9/2003 23:08'! enhancementPosts ^self archivePosts select: [ :post | post isEnhancement ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/9/2003 23:08'! fixPosts ^self archivePosts select: [ :post | post isFix ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/12/2003 16:43'! goodiePosts ^self archivePosts select: [ :post | post isGoodie ] ! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/19/2003 12:08'! postsForMonth: aMonth "This assumes a generic Month object ( which in Squeak, specifies the year as well )." ^self archivePosts select: [ :post | post dateSent month = aMonth ]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/18/2003 23:05'! postsForMonth: aNumber andYear: anotherNumber ^self archivePosts select: [ :post | (post dateSent year == anotherNumber) and: [ post dateSent month == aNumber ]]! ! !BugFixArchive methodsFor: 'enumerating' stamp: 'bkv 5/18/2003 23:05'! postsForYear: aNumber ^self archivePosts select: [ :post | post dateSent year == aNumber]! ! !BugFixArchive methodsFor: 'initialization' stamp: 'bkv 5/20/2003 14:53'! initialize aggregators _ OrderedCollection new. archivePosts _ OrderedCollection new. mailDbs _ OrderedCollection new. ! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/12/2003 22:49'! childrenForParentPost: anArchivePost self archivePosts select: [ :post | post parentPost postUrl = anArchivePost postUrl ].! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/16/2003 18:41'! loadUpdates self error: 'Implement me!!'! ! !BugFixArchive methodsFor: 'services' stamp: 'bkv 5/18/2003 23:05'! monthsRepresentedForYear: aNumber ^((self postsForYear: aNumber) collect: [ :ea | ea dateSent month ]) asBag asSortedCollection! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'bkv 5/8/2003 17:38'! new ^super new initialize! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'bkv 5/20/2003 14:56'! on: aListOfPosts | archive | archive _ self new. aListOfPosts do: [ :archivePost | archive addArchivePost: archivePost ]. ^archive! ! !BugFixArchive class methodsFor: 'instance creation' stamp: 'bkv 5/19/2003 14:28'! withAggregators: aListOfAggregators "Returns a BugFixArchive intialized with a list of objects that respond to the #collectLatestArchivePosts, #collectAllArchivePosts API." | archive | archive _ self new initialize. aListOfAggregators do: [ :aggregator | archive addAggregator: aggregator ]. ^archive! ! BugFixArchive class removeSelector: #default! BugFixArchive class removeSelector: #defaultBugFixArchiveUrls! BugFixArchive class removeSelector: #defaultBugFixArchiveUrlsAsOneGiantString! BugFixArchive class removeSelector: #defaultBugsArchiveUrl! BugFixArchive class removeSelector: #defaultBugsUri! BugFixArchive class removeSelector: #defaultFixesArchiveUrl! BugFixArchive class removeSelector: #defaultFixesUri! BugFixArchive class removeSelector: #defaultIsInitialized! BugFixArchive class removeSelector: #defaultLatestBugsUrl! BugFixArchive class removeSelector: #defaultLatestFixesUrl! BugFixArchive class removeSelector: #defaultListOfUrlPairs! BugFixArchive class removeSelector: #defaultRepositoryDirectory! BugFixArchive class removeSelector: #defaultServerUrl! BugFixArchive class removeSelector: #extractBugFixArchiveNumberFromUrl:! BugFixArchive class removeSelector: #getArchivePage! BugFixArchive class removeSelector: #getArchivePageForArchiveNumber:! BugFixArchive class removeSelector: #getArchiveServerUrl! BugFixArchive class removeSelector: #getArchiveUri! BugFixArchive class removeSelector: #getBugsArchiveServerUrl! BugFixArchive class removeSelector: #getFullArchivePage! BugFixArchive class removeSelector: #getFullArchiveUri! BugFixArchive class removeSelector: #on:withUrls:! BugFixArchive class removeSelector: #withUrls:! !BugFixArchive class reorganize! ('instance creation' new on: withAggregators:) ! BugFixArchive removeSelector: #asyncDoLoad:! BugFixArchive removeSelector: #bugsUri! BugFixArchive removeSelector: #bugsUri:! BugFixArchive removeSelector: #collectArchivedChangesetUrls! BugFixArchive removeSelector: #collectLatestArchiveChangesetUrls! BugFixArchive removeSelector: #extractChangesetUrlsFromArchivePage:! BugFixArchive removeSelector: #extractChangesetUrlsFromArchivePage:upToArchiveNumber:! BugFixArchive removeSelector: #fixEnhPosts! BugFixArchive removeSelector: #fixesUri! BugFixArchive removeSelector: #fixesUri:! BugFixArchive removeSelector: #initializeFully! BugFixArchive removeSelector: #initializeLightly! BugFixArchive removeSelector: #lastCachedArchiveNumber! BugFixArchive removeSelector: #lastCachedBugNumber! BugFixArchive removeSelector: #lastCachedFixNumber! BugFixArchive removeSelector: #lastCheckedArchiveNumber! BugFixArchive removeSelector: #lastCheckedArchiveNumber:! BugFixArchive removeSelector: #loadArchiveFromZipFile:! BugFixArchive removeSelector: #loadArchivesFromUrls! BugFixArchive removeSelector: #loadArchivesFromUrls:! BugFixArchive removeSelector: #loadDefaultArchivePosts! BugFixArchive removeSelector: #loadUpdatesFromDirectories:! BugFixArchive removeSelector: #loadUpdatesFromDirectory! BugFixArchive removeSelector: #loadUpdatesFromUrls! BugFixArchive removeSelector: #loadUpdatesFromUrls:! BugFixArchive removeSelector: #postsSortedByArchiveNumber! BugFixArchive removeSelector: #postsWithArchiveNumbers:! BugFixArchive removeSelector: #serverUrl! BugFixArchive removeSelector: #serverUrl:! BugFixArchive removeSelector: #sortPostsByArchiveNumber! BugFixArchive removeSelector: #sqBugsPosts! BugFixArchive removeSelector: #sqFixesPosts! !BugFixArchive reorganize! ('accessing' addAggregator: addArchivePost: addMailDb: archivePosts archivePosts: mailDbs mailDbs: removeAggregator: removeArchivePost: removeMailDb: repositoryDir repositoryDir: urls urls:) ('enumerating' announcementPosts bugPosts enhancementPosts fixPosts goodiePosts postsForMonth: postsForMonth:andYear: postsForYear:) ('initialization' initialize) ('services' childrenForParentPost: loadUpdates monthsRepresentedForYear:) ! ArchivePost class removeSelector: #getTypeForEmailTag! ArchivePost initialize! ArchivePost class removeSelector: #minimalWithArchive:withArchiveNumber:! ArchivePost class removeSelector: #minimalWithArchiveNumber:! ArchivePost class removeSelector: #parseArchiveNumbersFromHtmlList:! ArchivePost class removeSelector: #parseArchivePostsFromHtmlList:! ArchivePost class removeSelector: #parseArchivePostsFromIndexHtmlDoc:! ArchivePost class removeSelector: #withArchive:withArchiveNumber:! ArchivePost class removeSelector: #withArchive:withChangesetUrl:! ArchivePost class removeSelector: #withArchive:withPostUrl:! ArchivePost class removeSelector: #withArchiveNumber:! ArchivePost class removeSelector: #withChangesetUrl:! ArchivePost class removeSelector: #withPostUrl:! ArchivePost removeSelector: #addAttachmentUrl:! ArchivePost removeSelector: #archiveNumber! ArchivePost removeSelector: #archiveNumber:! ArchivePost removeSelector: #attachmentUrls:! ArchivePost removeSelector: #baseUrl! ArchivePost removeSelector: #baseUrl:! ArchivePost removeSelector: #changeSetIsSmall! ArchivePost removeSelector: #changesetUrl! ArchivePost removeSelector: #changesetUrl:! ArchivePost removeSelector: #downloadFileStreamForDirectory:! ArchivePost removeSelector: #fillInFromHtmlDoc! ArchivePost removeSelector: #fillInFromHtmlDoc:! ArchivePost removeSelector: #htmlDoc! ArchivePost removeSelector: #httpGet:! ArchivePost removeSelector: #httpGetArchivePost! ArchivePost removeSelector: #httpGetChangeSet! ArchivePost removeSelector: #httpGetChangeSetAsBinaryStream! ArchivePost removeSelector: #httpGetChangeSetAsMIMEDocument! ArchivePost removeSelector: #initializeChangeSetUrl! ArchivePost removeSelector: #initializeChangeSetUrlFromHtmlDoc:! ArchivePost removeSelector: #initializeDateSent! ArchivePost removeSelector: #initializeDateSentFromHtmlDoc:! ArchivePost removeSelector: #initializeFromArchiveNumber! ArchivePost removeSelector: #initializeFromChangeSetUrl! ArchivePost removeSelector: #initializeFromHtmlDoc! ArchivePost removeSelector: #initializeFromHtmlDoc:! ArchivePost removeSelector: #initializeFromPostUrl! ArchivePost removeSelector: #initializeFromUrl! ArchivePost removeSelector: #initializeNameAndEmailAddress! ArchivePost removeSelector: #initializeNameAndEmailFromHtmlDoc:! ArchivePost removeSelector: #initializePostUrl! ArchivePost removeSelector: #initializeText! ArchivePost removeSelector: #initializeTextFromHtmlDoc:! ArchivePost removeSelector: #initializeTitle! ArchivePost removeSelector: #initializeTitleFromHtmlDoc:! ArchivePost removeSelector: #loadPostDetails! ArchivePost removeSelector: #minimalInitFromHtmlDoc:! ArchivePost removeSelector: #parseChangeSetUrlFromHtmlDoc:! ArchivePost removeSelector: #parseChangesetUrlFromHtmlAnchor:! ArchivePost removeSelector: #parseDateFromArchiveString:! ArchivePost removeSelector: #parseDateFromHtmlDoc:! ArchivePost removeSelector: #parseDateFromTableRow:! ArchivePost removeSelector: #parseNameAndEmailFromHtmlDoc:! ArchivePost removeSelector: #parseNameAndEmailFromTableRow:! ArchivePost removeSelector: #parseTextFromHtmlDoc:! ArchivePost removeSelector: #parseTitleFromHtmlDoc:! ArchivePost removeSelector: #relativeFileNameForChangeset! ArchivePost removeSelector: #removeAttachmentUrl:! ArchivePost removeSelector: #saveChangeSetToDirectory:! ArchivePost removeSelector: #smallFileSize! ArchivePost removeSelector: #type! ArchivePost removeSelector: #type:! ArchivePost removeSelector: #uri! ArchivePost removeSelector: #uri:! !ArchivePost reorganize! ('testing' isAnnouncement isBug isBugAndFix isBugAndNotFix isBugOnly isChildOf: isEnhancement isFix isFixAndNotBug isGoodie isParentOf:) ('accessing' archive archive: attachmentDir attachmentUrls authorEmail authorEmail: authorName authorName: dateSent dateSent: groupDisplayLabel parentPost parentPost: postUrl postUrl: text text: title title: types types:) ('initialization' canonicalTags canonicalTypes initialize initializeGroupDisplayLabel initializeTypes parseTagsFromTitle tagForType: tagTypeMap) ('mail' mailServiceProvider) ('printing' adHocTitle describe:withBoldLabel:on: downloadFileName fullDescription printGroupDisplayLabelOn: printOn: printString tagForType) ('files') ('services' loadDetails loadUpdate reload) (' mail' postCommentViaEmail postCommentViaEmailTo:) ('http') !