| author | Claus Gittinger <cg@exept.de> |
| Mon, 26 Oct 2009 16:25:08 +0100 | |
| changeset 141 | 0f1d8459da84 |
| parent 32 | 1bd0dbe2a6c7 |
| child 208 | 0682c2d1c787 |
| permissions | -rw-r--r-- |
| 32 | 1 |
"{ Package: 'stx:goodies/monticello' }"
|
2 |
||
3 |
MCVersionReader subclass:#MCMczReader |
|
4 |
instanceVariableNames:'zip infoCache' |
|
5 |
classVariableNames:'' |
|
6 |
poolDictionaries:'' |
|
7 |
category:'Monticello-Storing' |
|
8 |
! |
|
9 |
||
10 |
||
11 |
!MCMczReader class methodsFor:'accessing'! |
|
12 |
||
13 |
extension |
|
14 |
^ 'mcz' |
|
15 |
! ! |
|
16 |
||
17 |
!MCMczReader class methodsFor:'testing'! |
|
18 |
||
19 |
supportsDependencies |
|
20 |
^ true |
|
21 |
! |
|
22 |
||
23 |
supportsVersions |
|
24 |
^ true |
|
25 |
! ! |
|
26 |
||
27 |
!MCMczReader methodsFor:'*monticello'! |
|
28 |
||
29 |
associate: tokens |
|
30 |
| result | |
|
31 |
result _ Dictionary new. |
|
|
141
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
32 |
Smalltalk isSmalltalkX ifTrue:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
33 |
tokens pairWiseDo: [:key :valueArg | |value| |
| 32 | 34 |
value := valueArg. |
35 |
value isString ifFalse: [value _ value collect: [:ea | self associate: ea]]. |
|
36 |
result at: key put: value]. |
|
|
141
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
37 |
] ifFalse:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
38 |
tokens pairsDo: [:key :valueArg | |value| |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
39 |
value := valueArg. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
40 |
value isString ifFalse: [value _ value collect: [:ea | self associate: ea]]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
41 |
result at: key put: value]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
42 |
]. |
| 32 | 43 |
^ result |
44 |
||
45 |
"Created: / 16-11-2006 / 16:39:45 / cg" |
|
46 |
! ! |
|
47 |
||
48 |
!MCMczReader methodsFor:'as yet unclassified'! |
|
49 |
||
50 |
extractDefinitionsFrom: member |
|
51 |
| reader | |
|
52 |
(MCSnapshotReader readerClassForFileNamed: member fileName) |
|
53 |
ifNotNilDo: [:rc | reader _ rc on: member contentStream text. |
|
54 |
definitions addAll: reader definitions] |
|
55 |
! |
|
56 |
||
57 |
extractDependencyFrom: zipMember |
|
58 |
^ MCVersionDependency |
|
59 |
package: (MCPackage named: (zipMember fileName copyAfterLast: $/)) |
|
60 |
info: (self extractInfoFrom: (self parseMember: zipMember fileName)) |
|
61 |
! |
|
62 |
||
63 |
extractInfoFrom: dict |
|
|
141
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
64 |
^ self infoCache at: (dict at: #id) ifAbsentPut: |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
65 |
[ |uuid| |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
66 |
|
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
67 |
Smalltalk isSmalltalkX ifTrue:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
68 |
uuid := (UUID fromBytes: (dict at: #id)). |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
69 |
] ifFalse:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
70 |
uuid := (UUID fromString: (dict at: #id)). |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
71 |
]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
72 |
MCVersionInfo |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
73 |
name: (dict at: #name ifAbsent: ['']) |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
74 |
id: uuid |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
75 |
message: (dict at: #message ifAbsent: ['']) |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
76 |
date: ([Date fromString: (dict at: #date) ] on: Error do: [ :ex | ex return: nil ]) |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
77 |
time: ([ Time fromString:(dict at: #time)] on: Error do: [ :ex | ex return: nil ]) |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
78 |
author: (dict at: #author ifAbsent: ['']) |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
79 |
ancestors: ((dict at: #ancestors) collect: [:ea | self extractInfoFrom: ea]) |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
80 |
stepChildren: ((dict at: #stepChildren ifAbsent: [#()]) collect: [:ea | self extractInfoFrom: ea])] |
| 32 | 81 |
! |
82 |
||
83 |
infoCache |
|
84 |
^ infoCache ifNil: [infoCache _ Dictionary new] |
|
85 |
! |
|
86 |
||
87 |
loadDefinitions |
|
|
141
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
88 |
|m| |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
89 |
|
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
90 |
definitions _ OrderedCollection new. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
91 |
|
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
92 |
Smalltalk isSmalltalkX ifTrue:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
93 |
m := self zip extract:'snapshot.bin'. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
94 |
m notNil ifTrue:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
95 |
[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
96 |
^ definitions _ (Object fromBinaryStoreBytes:m) definitions |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
97 |
] on: Error do: [:fallThrough ] |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
98 |
]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
99 |
] ifFalse:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
100 |
(self zip memberNamed: 'snapshot.bin') ifNotNilDo: |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
101 |
[:m | [^ definitions _ (DataStream on: m contentStream) next definitions] |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
102 |
on: Error do: [:fallThrough ]]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
103 |
]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
104 |
|
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
105 |
"otherwise" |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
106 |
(self zip membersMatching: 'snapshot/*') |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
107 |
do: [:m | self extractDefinitionsFrom: m]. |
| 32 | 108 |
! |
109 |
||
110 |
loadDependencies |
|
111 |
dependencies _ (self zip membersMatching: 'dependencies/*') collect: [:m | self extractDependencyFrom: m]. |
|
112 |
dependencies _ dependencies asArray. |
|
113 |
! |
|
114 |
||
115 |
loadPackage |
|
116 |
| dict | |
|
117 |
dict _ self parseMember: 'package'. |
|
118 |
package _ MCPackage named: (dict at: #name) |
|
119 |
! |
|
120 |
||
121 |
loadVersionInfo |
|
122 |
info _ self extractInfoFrom: (self parseMember: 'version') |
|
123 |
! |
|
124 |
||
125 |
parseMember: fileName |
|
|
141
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
126 |
| contents tokens | |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
127 |
|
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
128 |
Smalltalk isSmalltalkX ifTrue:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
129 |
contents := (self zip extract: fileName) asString. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
130 |
] ifFalse:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
131 |
contents := self zip contentsOf: fileName. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
132 |
]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
133 |
tokens _ (self scanner scanTokens: contents) first. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
134 |
^ self associate: tokens |
| 32 | 135 |
! |
136 |
||
137 |
scanner |
|
138 |
^ MCScanner |
|
139 |
! |
|
140 |
||
141 |
zip |
|
|
141
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
142 |
zip ifNil:[ |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
143 |
zip _ ZipArchive new. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
144 |
zip readFrom: stream |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
145 |
]. |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
146 |
^ zip |
| 32 | 147 |
! ! |
148 |
||
149 |
!MCMczReader class methodsFor:'documentation'! |
|
150 |
||
151 |
version |
|
|
141
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
152 |
^ '$Header: /cvs/stx/stx/goodies/monticello/MCMczReader.st,v 1.2 2009-10-26 15:25:08 cg Exp $' |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
153 |
! |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
154 |
|
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
155 |
version_CVS |
|
0f1d8459da84
more porting (but still unfinished)
Claus Gittinger <cg@exept.de>
parents:
32
diff
changeset
|
156 |
^ '$Header: /cvs/stx/stx/goodies/monticello/MCMczReader.st,v 1.2 2009-10-26 15:25:08 cg Exp $' |
| 32 | 157 |
! ! |