Smallwiki Assessment

Smallwiki doesn't provided a handy ways to check how big it was, here is a little code to make it very easy. From the SWKom holding the wiki, execute the following:

| classAudit |
classAudit := Dictionary new.
SWVisitorForProperty block:
           [:aWikiItem |
           classAudit at: aWikiItem class put: ((classAudit at: aWikiItem class ifAbsent: [0]) + 1)]
       start: (self root).
classAudit explore

Just knowing where the broken links are before converting can save some time:

| brokenLinkCheck |
brokenLinkCheck := Set new.
SWVisitorLinkInternal block: [:link :structure |
                      link isBroken
                              ifTrue: [brokenLinkCheck add: structure]]
       start: (self root).
brokenLinkCheck do: [:page | Transcript show: page url; cr]

Pier uses the + for creating embedded links, so its a good idea to check for pages that contain this in the title:

| pagesToRename parentPath |
pagesToRename := Set new.
SWVisitorStructure block: [:page | '+*/><@()&:,''"?' do: [:char | (page title includes: char) ifTrue: [pagesToRename add: page]]]
      start: self root.
pagesToRename do: [:page |
           parentPath := (page isRoot or: [page parent isRoot]) ifTrue: ['/'] ifFalse: [page pathOfTitlesForPier].
           Transcript cr; nextPutAll: '#('''; nextPutAll: parentPath;
                       nextPutAll: page title;
                       nextPutAll: ''' ''';
                       nextPutAll: (page timestamp date mmddyyyy, ' ', page timestamp time printString);
                       nextPutAll: ''')'].
Transcript flush

Since the operational team only had a limited number of pages with strange permissions, the permissions were changed manually:

| pagePermissionsCheck |
pagePermissionsCheck := Set new.
SWVisitorStructure block: [:page | (page roles notNil and: [page roles contains: [:r | r isBarrier]]) ifTrue: [pagePermissionsCheck add: page]]
      start: (self root).
pagePermissionsCheck explore.