'From Squeak2.7 of 5 January 2000 [latest update: #1782] on 6 April 2000 at 11:13:17 pm'! "Change Set: VarString Date: 6 April 2000 Author: Chris Reuter A quick hack to do Perl-style variable interpolation inside of strings. This will probably break (or at least bend) if the sources go missing. MIT License Copyright (c) 2000 Chris Reuter Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the 'Software'), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or subst! ! antial portions of the Software. THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. " ! Object subclass: #PerlStringFormatter instanceVariableNames: 'context names ' classVariableNames: 'MagicSymbols ' poolDictionaries: '' category: 'Perl Fandom'! !PerlStringFormatter commentStamp: 'cr 4/6/2000 23:09' prior: 0! This class will, given a string and a context, return a new string with all sequences of the form $XXXXX (where XXXXX is the name of a variable in the context) replaced with the actual value of that variable converted to a string. As an a! ! dded bonus, it also supports a few C-style backslash escapes (e.g. '\n' becomes newline). Backslashes can be used to escape things in the usual manner. Don't use this class directly--instead, use String>>likePerl. For example: |foo bar| foo := 99. bar := 'beer'. Quux := 'wall'. ^'$foo bottles of $bar on the $Quux.' You may surround the variable name with '{' and '}' to disambiguate it from the following text: vowel := 'a'. 'I''ll h${vowel}ve a banana.' ! !PerlStringFormatter reorganize! ('all' context: lookupFromStream: lookupVar: parseString: updateNames) ! !PerlStringFormatter methodsFor: 'all' stamp: 'cr 4/6/2000 20:45'! context: aContext context := aContext. self updateNames.! ! !PerlStringFormatter methodsFor: 'all' stamp: 'cr 4/6/2000 22:49'! lookupFromStream: rStream | d lookForBrace word | "Extract a variable name from the next n characters of aStream, look it up and return the resulting string. Errors result in an empty string being returned! ! ." word := WriteStream on: (String new: 20). "See if it's a brace-delimited variable (e.g. '${foo}bar')." d := rStream peek. lookForBrace := (d == ${). lookForBrace ifTrue: [rStream next]. "Check for somebody sticking a $ right at the end." rStream atEnd ifTrue: [^'']. "Scan forward to end of the variable, storing the letters in 'word'." [ rStream atEnd or: [ d := rStream peek. lookForBrace ifTrue: [d = $}] ifFalse: [d isAlphaNumeric not] ] ] whileFalse: [ word nextPut: d. rStream next. ]. "If the word is brace delimited, we need to eat the closing brace." lookForBrace ifTrue: [rStream next]. ^self lookupVar: word contents. ! ! !PerlStringFormatter methodsFor: 'all' stamp: 'cr 4/6/2000 22:39'! lookupVar: aString "Return the variable associated with 'aString' in the current context." "If it's a temp or instance var name, return it." (names includesKey: aString) ifTrue: [^(names at: aString) asString]. "Othe! ! rwise, check if it's in a pool." context receiver class sharedPools do: [ :pool | (pool includesKey: aString asSymbol) ifTrue: [^(pool at: aString asSymbol) asString]. ]. "Finally, check if it's global." (Smalltalk includesKey: aString asSymbol) ifTrue: [^(Smalltalk at: aString asSymbol) asString]. "Just return the empty string like a good little scripting feature." ^''. ! ! !PerlStringFormatter methodsFor: 'all' stamp: 'cr 4/6/2000 22:28'! parseString: aString "Parse aString as a Perl-ish string, expanding escape sequences and '$variable' sequences. Return a copy. Invalid syntax gets tolerated." | output input c n | output := WriteStream on: (String new: 100). input := ReadStream on: aString. [input atEnd] whileFalse: [ c := input next. (c == $\ and: [input atEnd not or: [c := nil. false]]) ifTrue: [ c := nil. n := input next. output nextPut: (MagicSymbols at: n ifAbsent: [n]). ]. (c == $$ and: [input atEnd not or: [c := ! ! nil. false]]) ifTrue: [ c := nil. output nextPutAll: (self lookupFromStream: input). ]. c ifNotNil: [output nextPut: c]. ]. ^output contents.! ! !PerlStringFormatter methodsFor: 'all' stamp: 'cr 4/6/2000 22:59'! updateNames "Create a new names dictionary to match this context." | index obj | names := Dictionary new. "Local temporaries first." index := 1. context tempNames do: [ :name | names at: name put: (context tempAt: index). index := index + 1. ]. "Instance variables next." index := 1. obj := context receiver. obj class allInstVarNames do: [ :name | (names includesKey: name) ifFalse: [names at: name put: (obj instVarAt: index)]. ]. obj class classPool associationsDo: [ :assoc | (names includesKey: assoc key) ifFalse: [names at: assoc key asString put: assoc value]. ]. ! ! !PerlStringFormatter class reorganize! ('instance creation' parseString:inContext:) ('class initialization' initialize) ! !PerlStringFormatter cl! ! ass methodsFor: 'instance creation' stamp: 'cr 4/6/2000 22:15'! parseString: aString inContext: aContext "Parse aString within aContext and do some Perl-ish transformations on it." | psf | psf := self new. psf context: aContext. ^psf parseString: aString.! ! !PerlStringFormatter class methodsFor: 'class initialization' stamp: 'cr 4/6/2000 21:30'! initialize MagicSymbols := Dictionary new. MagicSymbols at: $n put: Character cr; "ought to be 'lf' but cr is what Squeak uses for EOL" at: $r put: Character cr; at: $f put: Character newPage; at: $t put: Character tab.! ! !String methodsFor: 'perl' stamp: 'cr 4/6/2000 23:03'! likePerl "Return a copy with Perl-style interpolation performed on it." ^PerlStringFormatter parseString: self inContext: thisContext sender home.! ! PerlStringFormatter initialize! "Postscript: Initialize the class." PerlStringFormatter initialize. !