David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.1195.mcz
==================== Summary ====================
Name: System-dtl.1195
Author: dtl
Time: 8 December 2020, 4:10:40.495367 pm
UUID: 88a0ce82-643e-47c4-83e9-27404ce5f71f
Ancestors: System-eem.1194
Add DoItFirst to be the first thing in the system startup list, processing certain command line options prior to any additional image initialization.
DoItFirst image arguments:
--doit argumentlist "evaluate each argument as a doIt expression"
--evaluate arg "evaluate arg, print result then exit"
--file filename "evaluate contents of filename, print result then exit"
--filein filelist "file in each file named in fileList"
--cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"
--debug "enter a debugger as soon as possible in the startUp processing"
--help "print this message"
Some arguments have single character synonyms, -f is a synonym for --file, -d for --doit
A single '-' may be used instead of '--', -help is interpreted as --help
=============== Diff against System-eem.1194 ===============
Item was added:
+ Object subclass: #DoItFirst
+ instanceVariableNames: 'actions'
+ classVariableNames: 'Current'
+ poolDictionaries: ''
+ category: 'System-Support'!
+
+ !DoItFirst commentStamp: 'dtl 12/6/2020 14:39' prior: 0!
+ Be the first thing in the system startup list, and do things that should be done prior to any additional image initialization. If the first image argument is a recognized option, evaluate it. Image arguments are typically preceded by a '--' token on the command line.
+
+ DoItFirst image arguments:
+ --doit argumentlist "evaluate each argument as a doIt expression"
+ --evaluate arg "evaluate arg, print result then exit"
+ --file filename "evaluate contents of filename, print result then exit"
+ --filein filelist "file in each file named in fileList"
+ --cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"
+ --debug "enter a debugger as soon as possible in the startUp processing"
+ --help "print this message"
+
+ Some arguments have single character synonyms, -f is a synonym for --file, -d for --doit
+ A single '-' may be used instead of '--', -help is interpreted as --help
+ !
Item was added:
+ ----- Method: DoItFirst class>>current (in category 'class initialization') -----
+ current
+ "Protect against nil in case package was reloaded and existing startUp
+ methods refer to the current instance."
+ ^Current ifNil: [ Current := self new ]!
Item was added:
+ ----- Method: DoItFirst class>>initialize (in category 'class initialization') -----
+ initialize
+ Smalltalk addToStartUpList: self before: SmallInteger.!
Item was added:
+ ----- Method: DoItFirst class>>reevaluateCwd (in category 'reevaluate options') -----
+ reevaluateCwd
+ "If a -cwd option was specified on the command line, reevaluate it now.
+ May be called from FileDirectory class>>startUp: to reevaluate the command line
+ option to ensure that the default directory is ultimately set as specified by the -cwd
+ image command line option."
+
+ ^ self current evaluateArg: #cwd.!
Item was added:
+ ----- Method: DoItFirst class>>reevaluateDebug (in category 'reevaluate options') -----
+ reevaluateDebug
+ "The -debug option cannot be evaluated at DoInNow startUp time, but may be called
+ later in the startUp processing. If -debug was not specified as a command option this
+ method does nothing.
+
+ May be called from Delay>>startup to invoke a debugger at the earliest possible time."
+
+ ^ self current evaluateArg: #debug.!
Item was added:
+ ----- Method: DoItFirst class>>startUp: (in category 'system startup') -----
+ startUp: resuming
+ resuming ifTrue: [ Current := self new. Current evaluateArgs ]
+ !
Item was added:
+ ----- Method: DoItFirst>>actions (in category 'private') -----
+ actions
+ ^actions!
Item was added:
+ ----- Method: DoItFirst>>add:to:at: (in category 'private') -----
+ add: valuable to: actionList at: key
+ "Add valuable to the end of action list, and register it at key so that it may
+ be reevaluated at a later time if necessary."
+ actionList addLast: valuable.
+ actions at: key put: valuable.!
Item was added:
+ ----- Method: DoItFirst>>addFirst:to:at: (in category 'private') -----
+ addFirst: valuable to: actionList at: key
+ "Add valuable to the beginning of action list, and register it at key so that it may
+ be reevaluated at a later time if necessary."
+ actionList addFirst: valuable.
+ actions at: key put: valuable.!
Item was added:
+ ----- Method: DoItFirst>>addWithoutEvaluation:at: (in category 'private') -----
+ addWithoutEvaluation: valuable at: key
+ "Register action at key so that it may be reevaluated at a later time. Do not
+ evaluate in the startUp of DoItNow. Used when the action cannot yet be
+ evaluated because it requires startUp processing later in the startup list."
+ actions at: key put: valuable.!
Item was added:
+ ----- Method: DoItFirst>>cwd: (in category 'actions') -----
+ cwd: path
+ "Evaluate arg and print the result on stdout, or error message on stderr.
+ Exit immediately without saving the image."
+ (FileDirectory on: path) exists
+ ifTrue: [ FileDirectory setDefaultDirectory: path ]
+ ifFalse: [ FileStream stderr nextPutAll: path, ': directory does not exist'; lf; flush.
+ Smalltalk quitPrimitive ]
+ !
Item was added:
+ ----- Method: DoItFirst>>debug (in category 'actions') -----
+ debug
+ "halt and enter a debugger"
+ Halt new signal: self class name, ' inserted break in StartUpList processing'.!
Item was added:
+ ----- Method: DoItFirst>>doIt: (in category 'actions') -----
+ doIt: arguments
+ "Evaluate arguments and print the result on stdout, or error message on stderr.
+ Exit the image after any error."
+ arguments do: [ :arg |
+ [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush]
+ on: Error
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
+ Smalltalk quitPrimitive ]]!
Item was added:
+ ----- Method: DoItFirst>>evaluateArg: (in category 'evaluating') -----
+ evaluateArg: actionKey
+ "If actionKey is registered, then evaluate its action. This is intended to allow
+ a previously evaluated option to be reevaluated at a later point in the system
+ startup list if necessary."
+ (actions at: actionKey ifAbsent: []) ifNotNil: [:action | action value]!
Item was added:
+ ----- Method: DoItFirst>>evaluateArgs (in category 'evaluating') -----
+ evaluateArgs
+ | actionQueue |
+ actionQueue := self parse readStream.
+ [ actionQueue atEnd ] whileFalse: [ actionQueue next value ].
+ !
Item was added:
+ ----- Method: DoItFirst>>evaluateFileContents: (in category 'actions') -----
+ evaluateFileContents: fileName
+ "Evaluate the contents of a file and print the result on stdout, or error
+ message on stderr. Exit immediately without saving the image."
+
+ | fs arg |
+ [ [ fs := FileStream oldFileNamed: fileName. ]
+ on: FileDoesNotExistException
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
+ Smalltalk quitPrimitive ].
+ arg := fs contentsOfEntireFile.
+ ^ self evaluateOption: arg.
+ ] ensure: [ fs close ].
+ !
Item was added:
+ ----- Method: DoItFirst>>evaluateOption: (in category 'actions') -----
+ evaluateOption: arg
+ "Evaluate option and print the result on stdout, or error message on stderr.
+ Exit immediately without saving the image."
+ [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush]
+ on: Error
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush ].
+ Smalltalk quitPrimitive!
Item was added:
+ ----- Method: DoItFirst>>fileIn: (in category 'actions') -----
+ fileIn: fileNames
+ "File in each named file. On error, print a message to stderr and exit the image."
+ fileNames do: [ :arg |
+ [ | fs |
+ fs := FileStream oldFileNamed: arg.
+ FileStream stdout nextPutAll: 'file in ', fs name; lf; flush.
+ fs fileIn ]
+ on: Error
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
+ Smalltalk quitPrimitive ]]!
Item was added:
+ ----- Method: DoItFirst>>help (in category 'actions') -----
+ help
+ FileStream stdout nextPutAll: self class name, ' image arguments:'; lf.
+ { '--doit argumentlist "evaluate each argument as a doIt expression"' .
+ '--evaluate arg "evaluate arg, print result then exit"' .
+ '--file filename "evaluate contents of filename, print result then exit"' .
+ '--filein filelist "file in each file named in fileList"' .
+ '--cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"' .
+ '--debug "enter a debugger as soon as possible in the startUp processing"'.
+ '--help "print this message"'
+ } do: [ :e | FileStream stdout tab; nextPutAll: e; lf ].
+ FileStream stdout
+ nextPutAll: 'some arguments have single character synonyms, -f is a synonym for --file, -d for --doit'; lf;
+ nextPutAll: 'single ''-'' may be used instead of ''--'', -help is interpreted as --help'; lf;
+ flush.
+ Smalltalk quitPrimitive.
+
+ !
Item was added:
+ ----- Method: DoItFirst>>initialize (in category 'initialize-release') -----
+ initialize
+ actions := Dictionary new.
+ !
Item was added:
+ ----- Method: DoItFirst>>isArg: (in category 'private') -----
+ isArg: token
+ ^ token isEmpty not and: [ token beginsWith: '-' ].!
Item was added:
+ ----- Method: DoItFirst>>keyFor: (in category 'evaluating') -----
+ keyFor: argument
+ "Interpret an argument key from the command line. Be permissive in
+ allowing '-somearg' to be treated as '--somearg', and where possible let
+ '-s' be the single character synonym for '--somearg' "
+ ^ argument caseOf: {
+ "print help to stdout then exit"
+ [ '--help' ] -> [ #help ] .
+ [ '-help' ] -> [ #help ] .
+ [ '-h' ] -> [ #help ] .
+ "enter debugger as soon as possible"
+ [ '--debug' ] -> [ #debug ] .
+ [ '-debug' ] -> [ #debug ] .
+ "evaluate each argument string as a doIt"
+ [ '--doit' ] -> [ #doit ] .
+ [ '-doit' ] -> [ #doit ] .
+ [ '-d' ] -> [ #doit ] .
+ "evaluate expression and exit"
+ [ '--evaluate' ] -> [ #evaluate ] .
+ [ '-evaluate' ] -> [ #evaluate ] .
+ [ '-e' ] -> [ #evaluate ] .
+ "evaluate contents of file and exit"
+ [ '--file' ] -> [ #file ] .
+ [ '-file' ] -> [ #file ] .
+ [ '-f' ] -> [ #file ] .
+ "file in one or more files"
+ [ '--filein' ] -> [ #filein ] .
+ [ '-filein' ] -> [ #filein ] .
+ "change FileDirectory default directory"
+ [ '--cwd' ] -> [ #cwd ] .
+ [ '-cwd' ] -> [ #cwd ] .
+ [ '-c' ] -> [ #cwd ]
+ } otherwise: [ #ignore ].
+ !
Item was added:
+ ----- Method: DoItFirst>>nextTokensFrom: (in category 'evaluating') -----
+ nextTokensFrom: argumentStream
+ "Next available tokens up to the next parseable argument, for commands
+ that expect an argument list of names or doIt expressions."
+
+ | list |
+ list := OrderedCollection new.
+ [ argumentStream atEnd or: [ self isArg: argumentStream peek ]]
+ whileFalse: [ list add: argumentStream next ].
+ ^ list!
Item was added:
+ ----- Method: DoItFirst>>parse (in category 'evaluating') -----
+ parse
+ "Parse the argument list and answer a list of action selectors to be performed"
+ ^ self parse: Smalltalk arguments.
+ !
Item was added:
+ ----- Method: DoItFirst>>parse: (in category 'evaluating') -----
+ parse: argumentList
+ "Iterate over the argument list, adding action blocks to the actions dictionary.
+ If any action blocks require files or directory initialization send the appropriate
+ startUp message to do it now. Answer a list of option selectors that should be
+ evaluated."
+
+ | args actions needsFiles needsDirectory |
+ needsFiles := needsDirectory := false.
+ args := argumentList readStream.
+ actions := OrderedCollection new.
+ [ args atEnd ] whileFalse: [ | key |
+ (key := self keyFor: args next) caseOf: {
+ [ #help ] -> [ self addFirst: [ self help ] to: actions at: key. needsFiles := true] .
+ [ #debug ] -> [ self addWithoutEvaluation: [ self debug ] at: key] .
+ [ #doit ] -> [ | list | list := self nextTokensFrom: args. self add:[ self doIt: list ] to: actions at: key. needsFiles := true] .
+ [ #evaluate ] -> [ | arg | arg := args next. self add:[ self evaluateOption: arg ] to: actions at: key. needsFiles := true] .
+ [ #file ] -> [ | arg | arg := args next. self add:[ self evaluateFileContents: arg ] to: actions at: key. needsFiles := true] .
+ [ #filein ] -> [ | list | list := self nextTokensFrom: args. self add:[ self fileIn: list ] to: actions at: key. needsFiles := needsDirectory := true] .
+ [ #cwd ] -> [ | arg | arg := args next. self addFirst:[ self cwd: arg ] to: actions at: key. needsFiles := needsDirectory := true] .
+ } otherwise: [] ].
+ needsFiles ifTrue: [ FileStream startUp: true. "initialize stdout and stderr" ].
+ needsDirectory ifTrue: [ FileDirectory startUp "set default directory" ].
+ ^ actions.
+ !
Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.1194.mcz
==================== Summary ====================
Name: System-eem.1194
Author: eem
Time: 2 December 2020, 9:58:22.669121 pm
UUID: e3212f4a-d84c-4e35-b05e-ab5e16af91c0
Ancestors: System-tonyg.1193
When computing SystemNavigation>>allSentMessagesWithout: use anyAndAllSelectorsDo: which does a much better job than the existing code, and uses (indirectly) Scanner>>isMessageSelector: which provides a single point of definition to maintain cnsistency across tools, etc.
=============== Diff against System-tonyg.1193 ===============
Item was changed:
----- Method: SystemNavigation>>allSentMessagesWithout: (in category 'query') -----
allSentMessagesWithout: classesAndMessagesPair
"Answer the set of selectors which are sent somewhere in the system,
computed in the absence of the supplied classes and messages."
| sent absentClasses absentSelectors |
sent := IdentitySet new: CompiledMethod instanceCount.
absentClasses := classesAndMessagesPair first.
absentSelectors := classesAndMessagesPair second.
"sd 29/04/03"
+ Cursor execute showWhile:
+ [self environment allClassesAndTraitsDo:
+ [:cls |
+ ((absentClasses includes: cls) ifTrue: [{}] ifFalse: [{cls. cls classSide}]) do:
+ [:each |
+ (absentSelectors isEmpty
- Cursor execute showWhile: [
- self environment allClassesAndTraitsDo: [:cls |
- ((absentClasses includes: cls)
- ifTrue: [{}]
- ifFalse: [{cls. cls classSide}])
- do: [:each | (absentSelectors isEmpty
ifTrue: [each selectors]
+ ifFalse: [each selectors copyWithoutAll: absentSelectors]) do:
+ [:sel | "Include all sels, but not if sent by self"
+ (each compiledMethodAt: sel) anyAndAllSelectorsDo:
+ [:m|
+ m == sel ifFalse:
+ [sent add: m]]]]]].
- ifFalse: [each selectors copyWithoutAll: absentSelectors])
- do: [:sel | "Include all sels, but not if sent by self"
- (each compiledMethodAt: sel) allLiteralsDo: [:m |
- self flag: #dicuss. "mt: How to distinguish a symbol from a selector?"
- (m isSymbol and: [m size > 0 and: [m first isLowercase]])
- ifTrue: ["might be sent"
- m == sel ifFalse: [sent add: m]].
- ]]]]].
"The following may be sent without being in any literal frame"
Smalltalk specialSelectorNames do: [:sel | sent add: sel].
+ Smalltalk presumedSentMessages do: [:sel | sent add: sel].
+ ^sent!
- Smalltalk presumedSentMessages do: [:sel | sent add: sel].
- ^ sent.!
Eliot Miranda uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-eem.1017.mcz
==================== Summary ====================
Name: Tools-eem.1017
Author: eem
Time: 2 December 2020, 9:56:20.281149 pm
UUID: 03df7799-92b9-4912-bed6-c446397b0cf8
Ancestors: Tools-eem.1016
In the browsers use Compiledmethod>>anyAndAllMessages instead of CompiledMethod>>messages. false positives are more tolerable tnan omitted selectors sent via perform: et al.
e.g. HaloMorph>>#addRotateHandle: really does send
#startRot:with: and #doRot:with:, albeit indirectly via perform:.
=============== Diff against Tools-eem.1016 ===============
Item was changed:
----- Method: StringHolder>>withSelectorAndMessagesIn:evaluate: (in category '*Tools') -----
withSelectorAndMessagesIn: aCompiledMethod evaluate: aBlock
"Allow the user to choose one selector, chosen from the currently selected message's selector, as well as those of all messages sent by it, and evaluate aBlock on behalf of chosen selector. If there is only one possible choice, simply make it; if there are multiple choices, put up a menu, and evaluate aBlock on behalf of the the chosen selector, doing nothing if the user declines to choose any"
| selectorOrNil messages |
selectorOrNil := aCompiledMethod selector.
+ messages := aCompiledMethod anyAndAllMessages.
- messages := aCompiledMethod messages.
messages remove: selectorOrNil ifAbsent: ["do nothing"].
messages ifEmpty: "If only one item, there is no choice"
[^selectorOrNil ifNotNil: [aBlock value: selectorOrNil]].
self systemNavigation
showMenuOf: messages
withFirstItem: selectorOrNil
ifChosenDo: aBlock!
Eliot Miranda uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-eem.920.mcz
==================== Summary ====================
Name: Collections-eem.920
Author: eem
Time: 2 December 2020, 9:49:01.130251 pm
UUID: 3767683c-33f6-4874-9e6c-83719db04fe3
Ancestors: Collections-mt.919
Add Symbol>>isMessageSelector, implemented in terms of Scanner class>>isMessageSelector:
=============== Diff against Collections-mt.919 ===============
Item was added:
+ ----- Method: Symbol>>isMessageSelector (in category 'testing') -----
+ isMessageSelector
+ "Answer if the receiver is a valid message selector. This method is not perfect.
+ The compiler does allow all caps to be selectors but these are not included.
+ If AllowUnderscoreSelectors is true then _ is a valid selector but this will be excluded
+ also. But it is IMO more useful to exclude class names and hence exclude some rarely
+ used selectors than to erroneously identify class names as message selectors."
+
+ ^Scanner isMessageSelector: self!
Eliot Miranda uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-eem.452.mcz
==================== Summary ====================
Name: Compiler-eem.452
Author: eem
Time: 2 December 2020, 9:41:04.063795 pm
UUID: 4799ba54-ed87-4188-a653-e36499d92994
Ancestors: Compiler-eem.451
Provide an acceptably accurate means to test if a SYmbol is probably a message selector, Scanner class>>isMessageSelector:.
=============== Diff against Compiler-eem.451 ===============
Item was added:
+ ----- Method: Scanner class>>isMessageSelector: (in category 'testing') -----
+ isMessageSelector: aSymbol
+ "Answer if the argument is a valid message selector.
+ This is optimized for fast filtering."
+ | first last sz type |
+ (sz := aSymbol size) = 0 ifTrue: [^false].
+ first := aSymbol at: 1.
+ last := aSymbol at: sz.
+ type := TypeTable at: first asciiValue.
+
+ type == #xLetter ifTrue:
+ ["Alas some people (myself included) do create selectors with an initial capital.
+ But this is unusual, and it is even rarer for these to be unary selectors, so I think
+ it is better to exclude class names than include the few exceptions."
+ (first isUppercase and: [last ~~ $:]) ifTrue:
+ [^false].
+ "Could be unary or keyword, may include underscores if AllowUnderscoreSelectors.
+ It is possible to be more agressive here, filtering out two successive colons, but I'm lazy"
+ ^aSymbol allSatisfy: (AllowUnderscoreSelectors
+ ifTrue:
+ [last == $:
+ ifTrue: [[:c| c == $: or: [c == $_ or: [c isAlphaNumeric]]]]
+ ifFalse: [[:c| c ~~ $: and: [c == $_ or: [c isAlphaNumeric]]]]]
+ ifFalse:
+ [last == $:
+ ifTrue: [[:c| c == $: or: [c isAlphaNumeric]]]
+ ifFalse: [[:c| c ~~ $: and: [c isAlphaNumeric]]]])].
+
+ type == #xBinary ifTrue:
+ [^aSymbol allSatisfy: [:c| c == $| or: [(TypeTable at: c asciiValue) == #xBinary]]].
+
+ ^type == #xUnderscore
+ and: [AllowUnderscoreSelectors
+ and: [self isMessageSelector: aSymbol allButFirst]]
+
+ "| implemented |
+ implemented := Set new.
+ self systemNavigation allSelect: [:m| implemented add: m selector. false].
+ ^Symbol allSubInstances select: [:s| (implemented includes: s) not and: [self isMessageSelector: s]]"
+
+ "| implemented |
+ implemented := Set new.
+ self systemNavigation allSelect: [:m| implemented add: m selector. false].
+ ^implemented reject: [:s| self isMessageSelector: s]"!
David T. Lewis uploaded a new version of 60Deprecated to project The Trunk:
http://source.squeak.org/trunk/60Deprecated-dtl.85.mcz
==================== Summary ====================
Name: 60Deprecated-dtl.85
Author: dtl
Time: 2 December 2020, 9:44:10.427748 pm
UUID: 010bb2cd-bb23-4d42-aa88-84c21eefaa31
Ancestors: 60Deprecated-mt.84
Deprecate #totalSeconds and #millisecondClockValue in DateAndTime and refer senders to the canonical implementations in Time.
=============== Diff against 60Deprecated-mt.84 ===============
Item was added:
+ ----- Method: DateAndTime class>>millisecondClockValue (in category '*60Deprecated') -----
+ millisecondClockValue
+
+ self deprecated: 'Use Time class>>millisecondClockValue instead'.
+ ^ self clock millisecondClockValue!
Item was added:
+ ----- Method: DateAndTime class>>totalSeconds (in category '*60Deprecated') -----
+ totalSeconds
+
+ self deprecated: 'Use Time class>>totalSeconds instead'.
+ ^ self clock totalSeconds!
David T. Lewis uploaded a new version of Chronology-Core to project The Trunk:
http://source.squeak.org/trunk/Chronology-Core-dtl.64.mcz
==================== Summary ====================
Name: Chronology-Core-dtl.64
Author: dtl
Time: 2 December 2020, 9:43:40.709057 pm
UUID: b3804941-fd01-4700-a64b-b00c42165675
Ancestors: Chronology-Core-eem.63
Deprecate #totalSeconds and #millisecondClockValue in DateAndTime and refer senders to the canonical implementations in Time.
=============== Diff against Chronology-Core-eem.63 ===============
Item was removed:
- ----- Method: DateAndTime class>>millisecondClockValue (in category 'smalltalk-80') -----
- millisecondClockValue
-
- ^ self clock millisecondClockValue!
Item was removed:
- ----- Method: DateAndTime class>>totalSeconds (in category 'smalltalk-80') -----
- totalSeconds
-
- ^ self clock totalSeconds!
David T. Lewis uploaded a new version of WebClient-Core to project The Trunk:
http://source.squeak.org/trunk/WebClient-Core-dtl.127.mcz
==================== Summary ====================
Name: WebClient-Core-dtl.127
Author: dtl
Time: 2 December 2020, 9:21:11.256021 pm
UUID: b29c5835-46cf-4f51-b822-b3494063f3f7
Ancestors: WebClient-Core-mt.126
Eliminate the only known use of DateAndTime class>>totalSeconds, use the proper method in class Time instead.
=============== Diff against WebClient-Core-mt.126 ===============
Item was changed:
----- Method: WebUtils class>>logEntryFor:response: (in category 'misc') -----
logEntryFor: request response: response
"Create a log entry in common log format from the given request / response"
| entry logdate logsize |
"CLF prints date as [day/month/year:hour:min:sec zone]"
logdate := String streamContents:[:s| | date |
+ date := DateAndTime fromSeconds: Time totalSeconds.
- date := DateAndTime fromSeconds: DateAndTime totalSeconds.
s nextPut: $[.
date asDate printOn: s format: #( 1 2 3 $/ 2 1 2).
s nextPut: $:.
date asTime print24: true on: s.
s nextPutAll:(' ',
(date offset hours >= 0 ifTrue:['+'] ifFalse:['-']),
(date offset hours abs asString padded: #left to: 2 with: $0),
(date offset minutes abs asString padded: #left to: 2 with: $0)
).
s nextPut: $].
].
"CLF prints zero length as - "
logsize := response contentLength ifNil:[0].
logsize = 0 ifTrue:[logsize := '-'].
entry := String streamContents:[:s|
s
nextPutAll: (request remoteHost ifNil:[
"Substitute with the host header"
(request headerAt: 'host') copyUpTo: $:
]);
nextPutAll: ' -'; "RFC 1413 identity of client"
nextPutAll: ' -'; "TODO: userid of authenticated user"
nextPutAll: ' ', logdate;
nextPutAll: ' "', request requestLine, '"';
nextPutAll: ' ', response code;
nextPutAll: ' ', logsize.
].
^entry
!