The Trunk: SMBase-nice.94.mcz

Nicolas Cellier uploaded a new version of SMBase to project The Trunk:
http://source.squeak.org/trunk/SMBase-nice.94.mcz

==================== Summary ====================

Name: SMBase-nice.94
Author: nice
Time: 27 December 2009, 4:04:55 am
UUID: afd4bb82-b2ae-46ba-80ef-0e4105cf1d99
Ancestors: SMBase-ul.93

Cosmetic: move or remove a few temps inside closures

=============== Diff against SMBase-ul.93 ===============

Item was changed:
  ----- Method: SMDependencyAnalysis>>installPackageReleases: (in category 'calculation') -----
  installPackageReleases: packageReleases
  "Given a Set of wanted SMPackageReleases, calculate all possible
  installation scenarios. If the analysis succeeds, return true, otherwise false."
 
+
- | result subAnalysis |
  wantedReleases := packageReleases copy.
  "First classify the releases in different groups."
  self partitionReleases.
 
  "If there are no tricky releases, we are already done.
  No extra required releases needs to be installed or upgraded."
  trickyReleases isEmpty ifTrue: [^success := true].
 
  "Ok, that was the easy part. The releases left now needs to be processed
  so that we can find out the different scenarios of required releases that we need
  to install first. First we calculate all combinations of available working configurations
  for the tricky releases."
  self collectCombinationsOfConfigurations.
 
  "Based on all configuration combinations,
  compute possible combinations of dependency releases."
  self computeInstallSets.
 
  "Check if we have failed - meaning that there are no valid scenarios without conflicts."
  suggestedInstallSetsSet isEmpty ifTrue: [^success := false].
 
  "Ok, this means we have at least one solution *on this level*!! But we need to do the
  analysis recursively for all these sets of required releases..."
  subAnalysises := OrderedCollection new.
  success := false.
+ suggestedInstallSetsSet do: [:set | | result subAnalysis |
- suggestedInstallSetsSet do: [:set |
  subAnalysis := SMDependencyAnalysis task: task.
  result := subAnalysis installPackageReleases: set.
  result ifTrue: [success := true].
  subAnalysises add: subAnalysis].
 
  "Did at least one succeed? If so, then we have at least one possible scenario!!
  If not, then we need to do tweaking."
  ^success!

Item was changed:
  ----- Method: SMDependencyAnalysis>>removeOlderReleasesIn: (in category 'private') -----
  removeOlderReleasesIn: collectionOfReleases
  "Remove older multiple releases of the same package.
  2 scans to retain order."
 
+ | newestReleases |
- | newestReleases rel |
  newestReleases := Dictionary new.
  collectionOfReleases do: [:r |
+ | rel |
  rel := newestReleases at: r package ifAbsent: [newestReleases at: r package put: r].
  (r newerThan: rel) ifTrue: [newestReleases at: r package put: r]].
  ^collectionOfReleases select: [:r |
  (newestReleases at: r package) == r]!

Item was changed:
  ----- Method: SMDependencyAnalysis>>allInstallPaths (in category 'queries') -----
  allInstallPaths
  "For all paths, collect in reverse all releases to install.
  At each level, first we add trivially installable releases
  (those that have no dependencies), then installable releases
  (those that have one configuration fulfilled) and finally
  the tricky releases (those left).
  Note that we also return paths with conflicting releases
  of the same package and paths with releases that conflict with
  already installed releases - those paths can be tweaked - and
  paths that are supersets of other paths."
 
+ | installPaths |
- | installPaths releases |
  installPaths := OrderedCollection new.
  self allPathsDo: [:path |
+ | releases |
  releases := OrderedCollection new.
  path reverseDo: [:ana |
  releases addAll: (ana trivialToInstall difference: releases).
  releases addAll: (ana alreadyInstallable difference: releases).
  releases addAll: (ana trickyReleases difference: releases)
  "Below for debugging
  r := OrderedCollection new.
  r add: ana trivialToInstall; add: ana alreadyInstallable; add: ana trickyReleases.
  releases add: r"].
  installPaths add: releases].
  ^ installPaths!

Item was changed:
  ----- Method: SMInstallationDeviation>>selectedRelease:releases: (in category 'initialize-release') -----
  selectedRelease: aRelease releases: releases
 
+ | p others |
- | p others otherRequired |
  selectedRelease := aRelease.
  p := selectedRelease package.
  brokenConfigurations := OrderedCollection new.
  others := releases copyWithout: aRelease.
  others := others select: [:r | r package ~= p].
  others do: [:rel |
+ rel workingConfigurations do: [:conf | | otherRequired |
- rel workingConfigurations do: [:conf |
  otherRequired := conf requiredReleases select: [:r | r package ~= p].
  ((others includesAllOf: otherRequired) and:
  [(conf requiredReleases includes: selectedRelease) not])
  ifTrue: [brokenConfigurations add: conf]]]!

Item was changed:
  ----- Method: SMInstallationProposal>>collectConflictsIn: (in category 'initialize-release') -----
  collectConflictsIn: collectionOfReleases
  "Collect all conflicts where there are either
  - multiple releases of the same package and/or
  - another release of the same package already installed
  Return the conflicts as an IdentityDictionary with
  the package as key and the value being a Set of releases."
 
+ | conflicts |
- | conflicts set |
  conflicts := IdentityDictionary new.
+ collectionOfReleases do: [:r | | set |
- collectionOfReleases do: [:r |
  set := conflicts at: r package ifAbsent: [
  conflicts at: r package put: OrderedCollection new].
  set add: r].
  "Add the installed releases too"
  conflicts keysAndValuesDo: [:key :value |
  key isInstalled ifTrue: [value add: key installedRelease]].
  "Prune release sets with only one member"
  ^conflicts select: [:releaseSet | releaseSet size > 1]!

Item was changed:
  ----- Method: SMPackageInstallationTask>>calculateWantedReleases (in category 'private') -----
  calculateWantedReleases
  "The user gave us wanted packages.
  We need to figure out which actual releases of those
  we should try to install."
 
- | rel |
  wantedReleases := Set new.
+ wantedPackages do: [:p | | rel |
+ rel := self idealReleaseFor: p.
- wantedPackages do: [:p | rel := self idealReleaseFor: p.
  rel ifNotNil: [wantedReleases add: rel]]!

Item was changed:
  ----- Method: RcsDiff>>applyTo: (in category 'applying') -----
  applyTo: aString
  "Apply me to given String and return the patched String."
 
+ | space commandStream originalStream currentLine |
- | space commandStream originalStream nextCommand nextLine lineCount currentLine |
  space := Character space.
  commandStream := ReadStream on: commandLines.
  originalStream := ReadStream on: aString.
  currentLine := 1.
  ^String streamContents: [:stream |
+ | nextCommand |
  [nextCommand := commandStream next.
  nextCommand isNil] whileFalse: [
+ | nextLine lineCount |
  nextLine := (commandStream upTo: space) asNumber.
  lineCount := commandStream nextLine asNumber.
  [currentLine = nextLine]
  whileFalse: [stream nextPutAll: originalStream nextLine; cr. currentLine := currentLine + 1].
  nextCommand = $d
  ifTrue:[ lineCount timesRepeat: [originalStream nextLine. currentLine := currentLine + 1]]
  ifFalse:[ nextCommand = $a
  ifTrue:[ stream nextPutAll: originalStream nextLine; cr.
  currentLine := currentLine + 1.
  lineCount timesRepeat: [
  stream nextPutAll: commandStream nextLine; cr]]]].
  stream nextPutAll: originalStream upToEnd]!

Item was changed:
  ----- Method: SMUtilities class>>sendMail: (in category 'utilities') -----
  sendMail: aString
  "Send the given mail message, but check for modern mail senders."
 
+
- | server |
 
  Smalltalk at: #MailSender ifPresent: [ :mailSender |
  ^mailSender sendMessage: ((Smalltalk at: #MailMessage) from: aString).
  ].
 
  Smalltalk at: #MailComposition ifPresent: [ :mailComposition |
  ^mailComposition new
  messageText:  aString;
  open
  ].
 
  Smalltalk at: #Celeste ifPresent: [ :celeste |
  celeste isSmtpServerSet ifTrue: [
  Smalltalk at: #CelesteComposition ifPresent: [ :celesteComposition |
  ^celesteComposition
  openForCeleste: celeste current
  initialText: aString
  ]
  ]
  ].
 
+ Smalltalk at: #AdHocComposition ifPresent: [ :adHocComposition | | server |
- Smalltalk at: #AdHocComposition ifPresent: [ :adHocComposition |
  server := UIManager default request: 'What is your mail server for outgoing mail?'.
  ^adHocComposition
  openForCeleste: server
  initialText: aString
  ].
 
  ^self inform: 'Sorry, no known way to send the message'.
  !

Item was changed:
  ----- Method: SMDependencyTest>>setUp (in category 'as yet unclassified') -----
  setUp
+ | trivial1rel installed1rel installed2rel tricky2rel conf1 conf2 tricky3rel1 tricky3rel2 tricky1rel seaside httpview kom1 kom2 |
- | package trivial1rel installed1rel installed2rel tricky2rel conf1 conf2 tricky3rel1 tricky3rel2 tricky1rel seaside httpview kom1 kom2 |
  map := SMSqueakMap new reload.
  goranAccount := map newAccount: 'Goran' username: 'Goran' email: '[hidden email]'.
 
  "Add a few packages to test with:
 
  Tricky1 1
  Installed1 1
  Tricky2 1
  Tricky2 1
  Installed1 1
  TrivialToInstall1 1
  Tricky3 1
 
  Installed1 1
  TrivialToInstall1 1
  Tricky3 2
  Tricky3 2
  TrivialToInstall1 1
 
  Installed2 1
 
  Seaside
  KomHttpServer 1
 
  HttpView
  KomHttpServer 2
  "
  {
  {'A'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 3}.
  {'B'. {'Squeak3.6'. 'Stable'}. 2}.
  {'TrivialToInstall1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Installed1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Installed2'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'AlreadyInstallable1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Tricky1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Tricky2'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Tricky3'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 2}.
  {'Circular1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Circular2'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Circular3'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'Seaside'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
  {'KomHttpServer'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 2}.
  {'HttpView'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}.
+ } do: [:arr | | package |
- } do: [:arr |
  package := SMPackage newIn: map.
  package name: arr first.
  arr second do: [:cn | package addCategory: (map categoryWithNameBeginning: cn)].
  arr third timesRepeat: [package newRelease ].
  goranAccount addObject: package].
 
  trivial1rel := (map packageWithName: 'TrivialToInstall1') lastRelease.
  trivial1rel publisher: goranAccount.
 
  installed1rel := (map packageWithName: 'Installed1') lastRelease.
  installed1rel publisher: goranAccount; noteInstalled.
  installed2rel := (map packageWithName: 'Installed2') lastRelease.
  installed2rel publisher: goranAccount; noteInstalled.
 
  ((map packageWithName: 'AlreadyInstallable1') lastRelease
  publisher: goranAccount;
  addConfiguration)
  addRequiredRelease: installed1rel.
  "Tricky1 has just a single configuration with one installed and one not installed."
  tricky1rel := (map packageWithName: 'Tricky1') lastRelease.
  tricky2rel := (map packageWithName: 'Tricky2') lastRelease.
  (tricky1rel publisher: goranAccount; addConfiguration)
  addRequiredRelease: installed1rel; "already installed"
  addRequiredRelease: tricky2rel. "not installed"
 
  "Tricky2 has two configurations:
  1: an installed, a trivial one and Tricky3 r1.
  2: an installed, a trivial one and Tricky3 r2."
  conf1 := tricky2rel publisher: goranAccount; addConfiguration.
  conf2 := tricky2rel addConfiguration.
 
  tricky3rel1 := (map packageWithName: 'Tricky3') releases first.
  tricky3rel2 := (map packageWithName: 'Tricky3') lastRelease.
  tricky3rel1 publisher: goranAccount.
  tricky3rel2 publisher: goranAccount.
 
  conf1 addRequiredRelease: installed1rel; addRequiredRelease: trivial1rel; addRequiredRelease: tricky3rel1.
  conf2 addRequiredRelease: installed1rel; addRequiredRelease: trivial1rel; addRequiredRelease: tricky3rel2.
 
  "Tricky3rel2 has two configurations:
  1: trivial1
  2: installed2rel"
  conf1 := tricky3rel2 publisher: goranAccount; addConfiguration.
  conf2 := tricky3rel2 addConfiguration.
  conf1 addRequiredRelease: trivial1rel.
  conf2 addRequiredRelease: installed2rel.
 
 
  seaside := (map packageWithName: 'Seaside') lastRelease.
  seaside publisher: goranAccount.
  httpview := (map packageWithName: 'HttpView') lastRelease.
  httpview publisher: goranAccount.
  kom1 := (map packageWithName: 'KomHttpServer') firstRelease.
  kom1 publisher: goranAccount.
  kom2 := (map packageWithName: 'KomHttpServer') lastRelease.
  kom2 publisher: goranAccount.
 
  conf1 := seaside addConfiguration.
  conf2 := httpview addConfiguration.
  conf1 addRequiredRelease: kom1.
  conf2 addRequiredRelease: kom2!

Item was changed:
  ----- Method: SMFileCache>>download: (in category 'services') -----
  download: aDownloadable
  "Download the file for this SMObject into the local file cache.
  If the file already exists, delete it.
  No unpacking or installation into the running image."
 
+
+ [ | file dir fileName |fileName := aDownloadable downloadFileName.
- | stream file fileName dir |
- [fileName := aDownloadable downloadFileName.
  fileName
  ifNil: [self inform: 'No download url, can not download.'.
  ^ false].
  fileName isEmpty
  ifTrue: [self inform: 'Download url lacks filename, can not download.'.
  ^ false].
  dir := aDownloadable cacheDirectory.
+ [ | stream |
+ stream := self getStream: aDownloadable.
- [stream := self getStream: aDownloadable.
  stream ifNil: [^ false].
  (dir fileExists: fileName)
  ifTrue: [dir deleteFileNamed: fileName].
  file := dir newFileNamed: fileName.
  file binary; nextPutAll: stream contents]
  ensure: [file ifNotNil: [file close]]]
  on: Error
  do: [^ false].
  ^ true!

Item was changed:
  ----- Method: SMDVSInstaller class>>canInstall: (in category 'testing') -----
  canInstall: aPackage
  "Can I install this? First we check if class StreamPackageLoader
  is available, otherwise DVS isn't installed.
  Then we check if the package is categorized with package
  format DVS - currently we have hardcoded the id of that category."
 
+
+ Smalltalk at: #StreamPackageLoader ifPresentAndInMemory: [ :loader | | fileName |
- | fileName |
- Smalltalk at: #StreamPackageLoader ifPresentAndInMemory: [ :loader |
  fileName := aPackage downloadFileName.
  fileName ifNil: [^false].
  fileName := fileName asLowercase.
  ^((fileName endsWith: '.st') or: [fileName endsWith: '.st.gz'])
  and: [aPackage categories includes: "The DVS format category"
  (SMSqueakMap default
  categoryWithId: 'b02f51f4-25b4-4117-9b65-f346215a8e41')]].
  ^false!

Item was changed:
  ----- Method: SMSqueakMap>>check (in category 'queries') -----
  check
  "Sanity checks."
 
  "SMSqueakMap default check"
 
+ (((self packages inject: 0 into: [:sum :p | sum + p releases size]) +
- (((self packages inject: 0 into: [:sum :p | sum := sum + p releases size]) +
  self accounts size +
  self packages size +
  self categories size) = SMSqueakMap default objects size)
  ifFalse: [self error: 'Count inconsistency in map'].
 
  objects do: [:o |
  o map == self
  ifFalse: [self error: 'Object with wrong map']].
  self packages do: [:p |
  (p releases allSatisfy: [:r | r map == self])
  ifFalse: [self error: 'Package with release pointing to wrong map']].
 
  self packageReleases do: [:r |
  r package map == self ifFalse: [self error: 'Release pointing to package in wrong map']]!

Item was changed:
  ----- Method: SMInstallationProposal>>calculateDeviations (in category 'initialize-release') -----
  calculateDeviations
  "Calculate deviations. Currently we just pick the newest release."
 
+ | conflicts |
- | conflicts newest |
  deviations := OrderedCollection new.
  conflicts := self collectConflictsIn: installList.
+ conflicts keysAndValuesDo: [:package :releases | | newest |
- conflicts keysAndValuesDo: [:package :releases |
  newest := releases first.
  releases do: [:r | (r newerThan: newest) ifTrue: [newest := r]].
  deviations add: (SMInstallationDeviation selectedRelease: newest releases: installList)]!

Item was changed:
  ----- Method: SMDependencyAnalysis>>bestInstallPath (in category 'queries') -----
  bestInstallPath
  "Using some heuristics we suggest the best path:
  - No conflicts
  - Fewest releases
  - If same packages, the newest releases"
 
+ | paths min points sc |
- | paths min points point package sc |
  paths := self installPathsWithoutConflicts.
  paths size = 1 ifTrue: [^paths first].
  min := paths inject: 999 into: [:mi :p | p size < mi ifTrue: [p size] ifFalse: [mi]].
  paths := paths select: [:p | p size = min].
  paths size = 1 ifTrue: [^paths first].
  "Try to pick the one with newest releases"
  points := Dictionary new.
+ paths do: [:p | | point |
- paths do: [:p |
  point := 0.
+ p do: [:r | | package |
- p do: [:r |
  package := r package.
  paths do: [:p2 |
  p2 == p ifFalse: [
  (p2 anySatisfy: [:r2 |
  (r2 package == package) and: [r newerThan: r2]])
  ifTrue:[point := point + 1]]]].
  points at: p put: point].
  points isEmpty ifTrue: [^nil].
  sc := points associations asSortedCollection: [:a :b | a value >= b value].
  ^ sc first key!

Item was changed:
  ----- Method: SMSqueakMap class>>pingServer: (in category 'server detection') -----
  pingServer: aServerName
  "Check if the SqueakMap server is responding.
  For an old image we first make sure the name resolves -
  the #httpGet: had such a long timeout (and hanging?)
  for resolving the name."
 
+ | answer |
- | url answer |
  "Only test name lookup first if image is before the network rewrite,
  after the rewrite it works."
+ [ | url |
+ (SystemVersion current highestUpdate < 5252)
- [(SystemVersion current highestUpdate < 5252)
  ifTrue: [NetNameResolver addressForName: (aServerName upTo: $:) timeout: 5].
  url := 'http://', aServerName, '/ping'.
  answer := HTTPSocket httpGet: url]
  on: Error do: [:ex | ^false].
  ^answer isString not and: [answer contents = 'pong']!

Item was changed:
  ----- Method: SMUtilities class>>stripEmailFrom: (in category 'utilities') -----
  stripEmailFrom: aString
  "Picks out the email from:
  'Robert Robertson <[hidden email]>' => '[hidden email]'
  Spamblockers 'no_spam', 'no_canned_ham' and 'spam_block'
  (case insensitive) will be filtered out."
 
+ | lessThan moreThan email |
- | lessThan moreThan email pos |
  lessThan := aString indexOf: $<.
  moreThan := aString indexOf: $>.
  (lessThan * moreThan = 0) ifTrue: [^ aString].
  email := (aString copyFrom: lessThan + 1 to: moreThan - 1) asLowercase.
+ #('no_spam' 'no_canned_ham' 'spam_block') do: [:block | | pos |
- #('no_spam' 'no_canned_ham' 'spam_block') do: [:block |
  pos := email findString: block.
  pos = 0 ifFalse:[email := (email copyFrom: 1 to: pos - 1), (email copyFrom: pos + block size to: email size)]].
  ^email!

Item was changed:
  ----- Method: SMSqueakMap>>accountForName: (in category 'queries') -----
  accountForName: name
  "Find account given full name. Disregarding case
  and allows up to 2 different characters.
  Size must match though, someone else can be smarter -
  this is just for migrating accounts properly."
 
+ | lowerName size |
- | lowerName size aName |
  lowerName := name asLowercase.
  size := lowerName size.
  ^self accounts
  detect: [:a |
+ | aName |
  aName := a name asLowercase.
  (aName size = size) and: [| errors |
  errors := 0.
  aName with: lowerName do: [:c1 :c2 |
  c1 ~= c2 ifTrue: [errors := errors + 1]].
  errors < 3
  ]]
  ifNone: [nil]
  !

Item was changed:
  ----- Method: SMInstallationRegistry>>installedPackages (in category 'queries') -----
  installedPackages
  "Answer all packages that we know are installed.
  Lazily initialize. The Dictionary contains the installed packages
  using their UUIDs as keys and the version string as the value."
 
+ | result |
- | result p |
  result := OrderedCollection new.
  installedPackages ifNil: [^#()]
  ifNotNil: [installedPackages keys
+ do: [:k | | p |
- do: [:k |
  p := map object: k.
  p ifNotNil: [result add: p]]].
  ^result!