'From Squeakland 3.8-05 of 7 September 2005 [latest update: #479] on 1 February 2006 at 2:13:25 pm'!
"Change Set:		SuperSwikiString-KR
Date:			1 February 2006
Author:			Korakurider

Current m18n implementation assumes shift_jis encoding is used in wire protocol between
SuperSwiki server and client.  Then some existing projects encoded in other than shift_jis
cause walkback. 

This patch introduces 'encodingName' for ServerDirectory entry (even in knownServer entry) 
so that appropriate encoding can be specified for each server.  If not specified, encoding is determined based on current locale.
"!

Object subclass: #ServerDirectory
	instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName '
	classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers '
	poolDictionaries: ''
	category: 'Network-RemoteDirectory'!

!JapaneseEnvironment methodsFor: 'utilities' stamp: 'KR 1/30/2006 22:28'!
setupSqueaklandSpecifics
	| server |
	ChangeSet current name: 'Unnamed' translated , '1'.
	ServerDirectory resetServers.
	server := SuperSwikiServer new type: #http;
				 server: 'squeakland.jp';
				 directory: '/super/SuperSwikiProj';
				 acceptsUploads: (Preferences eToyFriendly not);
				 encodingName: 'shift_jis'.
	ServerDirectory servers at: 'Squeakland.JP' put: server.
	Smalltalk garbageCollect! !


!ServerDirectory methodsFor: 'accessing' stamp: 'KR 2/1/2006 12:46'!
encodingName
	^encodingName.! !

!ServerDirectory methodsFor: 'accessing' stamp: 'KR 1/30/2006 22:15'!
encodingName: aName
	encodingName _ aName! !

!ServerDirectory methodsFor: 'file-in/out' stamp: 'KR 2/1/2006 12:40'!
storeServerEntryOn: stream
	
	stream
		nextPutAll: 'name:'; tab; nextPutAll: (ServerDirectory nameForServer: self); cr;
		nextPutAll: 'directory:'; tab; nextPutAll: self directory; cr;
		nextPutAll: 'type:'; tab; nextPutAll: self typeForPrefs; cr;
		nextPutAll: 'server:'; tab; nextPutAll: self server; cr.
	group
		ifNotNil: [stream nextPutAll: 'group:'; tab; nextPutAll: self groupName; cr].
	self user
		ifNotNil: [stream nextPutAll: 'user:'; tab; nextPutAll: self user; cr].
	self passwordSequence
		ifNotNil: [stream nextPutAll: 'passwdseq:'; tab; nextPutAll: self passwordSequence asString; cr].
	self altUrl
		ifNotNil: [stream nextPutAll: 'url:'; tab; nextPutAll: self altUrl; cr].
	self loaderUrl
		ifNotNil: [stream nextPutAll: 'loaderUrl:'; tab; nextPutAll: self loaderUrl; cr].
	self acceptsUploads
		ifTrue: [stream nextPutAll: 'acceptsUploads:'; tab; nextPutAll: 'true'; cr].
	self encodingName
		ifNotNil: [stream nextPutAll: 'encodingName:'; tab; nextPutAll: self encodingName; cr].! !


!ServerDirectory class methodsFor: 'server prefs' stamp: 'KR 1/30/2006 22:16'!
parseServerEntryFrom: stream
	
	| server type directory entries serverName |

	entries _ ExternalSettings parseServerEntryArgsFrom: stream.

	serverName _ entries at: 'name' ifAbsent: [^nil].
	directory _ entries at: 'directory' ifAbsent: [^nil].
	type _ entries at: 'type' ifAbsent: [^nil].
	type = 'file'
		ifTrue: [
			server _ self determineLocalServerDirectory: directory.
			entries at: 'userListUrl' ifPresent:[:value | server eToyUserListUrl: value].
			entries at: 'baseFolderSpec' ifPresent:[:value | server eToyBaseFolderSpec: value].
			^self addLocalProjectDirectory: server].
	type = 'bss'
		ifTrue: [server _ SuperSwikiServer new type: #http].
	type = 'http'
		ifTrue: [server _ HTTPServerDirectory new type: #ftp].
	type = 'ftp'
		ifTrue: [server _ ServerDirectory new type: #ftp].

	server directory: directory.
	entries at: 'server' ifPresent: [:value | server server: value].
	entries at: 'user' ifPresent: [:value | server user: value].
	entries at: 'group' ifPresent: [:value | server groupName: value].
	entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber].
	entries at: 'url' ifPresent: [:value | server altUrl: value].
	entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value].
	entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true'].
	entries at: 'userListUrl' ifPresent:[:value | server eToyUserListUrl: value].
	entries at: 'encodingName' ifPresent:[:value | server encodingName: value].
	ServerDirectory addServer: server named: serverName.
! !


!String methodsFor: 'converting' stamp: 'KR 1/30/2006 21:47'!
convertFromEncoding: encodingName
	^self convertFromWithConverter: (TextConverter newForEncoding: encodingName)! !

!String methodsFor: 'converting' stamp: 'KR 1/30/2006 21:47'!
convertFromSuperSwikiServerString
	^self convertFromEncoding: 'shift_jis'! !

!String methodsFor: 'converting' stamp: 'KR 1/30/2006 21:49'!
convertToEncoding: encodingName
	^self convertToWithConverter: (TextConverter newForEncoding: encodingName).! !

!String methodsFor: 'converting' stamp: 'KR 1/30/2006 21:50'!
convertToSuperSwikiServerString
	^self convertToEncoding: 'shift_jis'! !


!SuperSwikiServer methodsFor: 'testing' stamp: 'KR 1/30/2006 21:59'!
showQueryAsPVM: resultStream
	| answer gif whatToShow projectName fileName firstURL wrapper currX currY maxX maxY rawProjectName |
"SuperSwikiServer testOnlySuperSwiki queryProjectsAndShow"

	resultStream reset; nextLine.
	answer _ RectangleMorph new
		useRoundedCorners;
		borderWidth: 0;
		borderColor: Color blue;
		color: Color paleBlue.
	currX _ currY _ maxX _ maxY _ 10.
	[resultStream atEnd] whileFalse: [
		rawProjectName _ resultStream nextLine.
		projectName _ rawProjectName convertFromEncoding: self encodingName.
		fileName _ resultStream nextLine convertFromEncoding: self encodingName.
		gif _ self oldFileOrNoneNamed: rawProjectName,'.gif'.
		gif ifNotNil: [gif _ GIFReadWriter formFromStream: gif].
		currX > 600 ifTrue: [
			currX _ 10.
			currY _ maxY + 10.
		].
		gif ifNil: [
			gif _ AlignmentMorph newColumn
				hResizing: #shrinkWrap;
				vResizing: #shrinkWrap;
				borderWidth: 8;
				borderColor: Color red;
				color: Color lightRed;
				addMorph: (StringMorph contents: 'No GIF for ',projectName);
				fullBounds;
				imageForm
		].
		firstURL _ self url.
		firstURL last == $/ ifFalse: [firstURL _ firstURL, '/'].

		whatToShow _ ProjectViewMorph new
			image: (gif asFormOfDepth: Display depth);
			lastProjectThumbnail: gif;
			setProperty: #SafeProjectName toValue: projectName;
			project: (DiskProxy 
				global: #Project 
				selector: #namedUrl: 
				args: {firstURL,fileName}
			).

		answer addMorphBack: (whatToShow position: currX @ currY).
		currX _ currX + whatToShow width + 10.
		maxX _ maxX max: currX.
		maxY _ maxY max: currY + whatToShow height.
	].
	maxX = 10 ifTrue: [
		^self inform: 'No projects found for your criteria'
	].
	answer extent: (maxX @ maxY) + (0@10).
	wrapper _ ScrollPane new extent: (answer width + 10) @ (answer height min: 400).
	wrapper color: Color white.
	wrapper scroller addMorph: answer.
	wrapper 
		becomeModal;
		openCenteredInWorld;
		useRoundedCorners;
		setScrollDeltas.! !

!SuperSwikiServer methodsFor: 'for real' stamp: 'KR 1/30/2006 21:59'!
fastParseEntriesFrom: aString

	| c first strm xEntryName xCreationTime xModificationTime xIsDirectory xFileSize ch |

	c _ OrderedCollection new.
	first _ true.
	aString linesDo: [ :x |
		first ifFalse: [
			strm _ ReadStream on: x.
			(strm upTo: $ ) = '(DirectoryEntry' ifFalse: [^nil].
			(strm upTo: $ ) = 'name:' ifFalse: [^nil].
			xEntryName _ WriteStream on: String new.
			strm next = $' ifFalse: [^nil].
			[
				ch _ strm next.
				ch = $' and: [(strm peekFor: $') not]
			] whileFalse: [
				xEntryName nextPut: ch.
			].
			xEntryName _ xEntryName contents.
			strm skipSeparators.
			(strm upTo: $ ) = 'creationTime:' ifFalse: [^nil].
			xCreationTime _ (strm upTo: $ ) asNumber.
			(strm upTo: $ ) = 'modificationTime:' ifFalse: [^nil].
			xModificationTime _ (strm upTo: $ ) asNumber.
			(strm upTo: $ ) = 'isDirectory:' ifFalse: [^nil].
			xIsDirectory _ (strm upTo: $ ) = 'true'.
			(strm upTo: $ ) = 'fileSize:' ifFalse: [^nil].
			xFileSize _ (strm upTo: $ ) asNumber.

			c add: (DirectoryEntry 
				name: (xEntryName convertFromEncoding: self encodingName)
				creationTime: xCreationTime 
				modificationTime: xModificationTime 
				isDirectory: xIsDirectory 
				fileSize: xFileSize
			)
		].
		first _ false.
	].
	^c
! !

!SuperSwikiServer methodsFor: 'for real' stamp: 'KR 1/30/2006 22:02'!
oldFileNamed: aName

	| answer |

	answer _ self sendToSwikiProjectServer: {
		'action: readnamedfile'.
		'projectname: ',aName convertToEncoding: self encodingName.
	}.
	(answer beginsWith: 'OK') ifFalse: [ ^nil].
	^(SwikiPseudoFileStream with: (answer allButFirst: 3))
		reset;
		directory: self;
		localName: (aName convertToEncoding: self encodingName);
		yourself
! !

!SuperSwikiServer methodsFor: 'for real' stamp: 'KR 1/30/2006 21:57'!
putFile: fileStream named: fileNameOnServer

	
	^(
		self sendToSwikiProjectServer: {
			'uploadproject: ',fileNameOnServer convertToEncoding: self encodingName.
			'password: ',ProjectPasswordNotification signal.
			fileStream contentsOfEntireFile.
		}
	) beginsWith: 'OK'
! !

!SuperSwikiServer methodsFor: 'for real' stamp: 'KR 1/30/2006 22:00'!
updateProjectInfoFor: aProject

	| data details projectLinks linkString uploader |

	data _ OrderedCollection new.
	data add: 'action: updatepage'.
	data add: 'password: ',ProjectPasswordNotification signal.
	data add: ('projectimage: ',aProject name convertToEncoding: self encodingName, '.gif').
	uploader _ Utilities authorNamePerSe.
	uploader isEmptyOrNil ifTrue: [uploader _ Utilities authorInitialsPerSe].
	uploader isEmptyOrNil ifFalse: [
		data add: ('submittedBy: ',uploader convertToEncoding: self encodingName).
	].
	projectLinks _ Set new.
	aProject world allMorphsDo: [ :each |
		(each isKindOf: ProjectViewMorph) ifTrue: [
			projectLinks add: each safeProjectName.
		].
	].
	details _ aProject world valueOfProperty: #ProjectDetails ifAbsent: [Dictionary new].
	details at: 'projectname' ifAbsentPut: [aProject name].
	projectLinks isEmpty ifTrue: [
		details removeKey: 'projectlinks' ifAbsent: []
	] ifFalse: [
		linkString _ String streamContents: [ :strm |
			projectLinks asSortedCollection do: [ :each |
				strm nextPutAll: each
			] separatedBy: [
				strm nextPut: $.
			].
		].
		details at: 'projectlinks' put: linkString
	].
	details keysAndValuesDo: [ :k :v |
		data add: k , ': ' , (v convertToEncoding: self encodingName). self flag: #yoFlag.
	].
	^self sendToSwikiProjectServer: data.
! !

!SuperSwikiServer methodsFor: 'squeaklets' stamp: 'KR 1/30/2006 22:15'!
upLoadProject: projectName members: archiveMembers retry: aBool
	| answer |
	archiveMembers do:[:entry|
		ProgressNotification signal: '4:uploadingFile' extra:'(uploading ' translated, entry fileName convertFromSystemString , '...)' translated.
		answer _ self sendToSwikiProjectServer: {
			'uploadproject2: ', entry fileName convertFromSystemString convertToEncoding: self encodingName.
			'password: ',ProjectPasswordNotification signal.
			entry contents.
		}.
		answer = 'OK' ifFalse:[
			self inform:'Server responded ' translated, answer.
			^false].
	].
	ProgressNotification signal: '4:uploadingFile' extra:''.
	^true! !

!SuperSwikiServer methodsFor: 'accessing' stamp: 'KR 2/1/2006 13:07'!
encodingName
	(super encodingName) ifNil: [ ^SuperSwikiServer defaultEncodingName ] ifNotNil: [^super encodingName].! !


!SuperSwikiServer class methodsFor: 'as yet unclassified' stamp: 'KR 2/1/2006 13:18'!
defaultEncodingName
	Locale current isoLanguage = 'ja' ifTrue: [^'shift_jis' copy] ifFalse: [^'latin1' copy].
! !

WideString removeSelector: #convertToSuperSwikiServerString!
SuperSwikiServer removeSelector: #defaultEncodingName!
ByteString removeSelector: #convertFromSuperSwikiServerString!
Object subclass: #ServerDirectory
	instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject client loaderUrl eToyUserListUrl eToyUserList keepAlive encodingName'
	classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers'
	poolDictionaries: ''
	category: 'Network-RemoteDirectory'!