1implement Archives; 2include "sys.m"; 3 sys: Sys; 4include "draw.m"; 5include "bufio.m"; 6 bufio: Bufio; 7 Iobuf: import bufio; 8include "sets.m"; 9 sets: Sets; 10 Set, set, A, B, All, None: import sets; 11include "string.m"; 12 str: String; 13include "spree.m"; 14 spree: Spree; 15 Clique, Member, Attributes, Attribute, Object: import spree; 16 MAXPLAYERS: import Spree; 17 18stderr: ref Sys->FD; 19 20Qc: con " \t{}=\n"; 21Saveinfo: adt { 22 clique: ref Clique; 23 idmap: array of int; # map clique id to archive id 24 memberids: Set; # set of member ids to archive 25}; 26 27Error: exception(string); 28 29Cliqueparse: adt { 30 iob: ref Iobuf; 31 line: int; 32 filename: string; 33 lasttok: int; 34 errstr: string; 35 36 gettok: fn(gp: self ref Cliqueparse): (int, string) raises (Error); 37 lgettok: fn(gp: self ref Cliqueparse, t: int): string raises (Error); 38 getline: fn(gp: self ref Cliqueparse): list of string raises (Error); 39 error: fn(gp: self ref Cliqueparse, e: string) raises (Error); 40}; 41 42WORD: con 16rff; 43 44init(cliquemod: Spree) 45{ 46 sys = load Sys Sys->PATH; 47 stderr = sys->fildes(2); 48 bufio = load Bufio Bufio->PATH; 49 if (bufio == nil) { 50 sys->fprint(stderr, "cliquearchive: cannot load %s: %r\n", Bufio->PATH); 51 raise "fail:bad module"; 52 } 53 sets = load Sets Sets->PATH; 54 if (sets == nil) { 55 sys->fprint(stderr, "cliquearchive: cannot load %s: %r\n", Sets->PATH); 56 raise "fail:bad module"; 57 } 58 str = load String String->PATH; 59 if (str == nil) { 60 sys->fprint(stderr, "cliquearchive: cannot load %s: %r\n", String->PATH); 61 raise "fail:bad module"; 62 } 63 sets->init(); 64 spree = cliquemod; 65} 66 67write(clique: ref Clique, info: list of (string, string), name: string, memberids: Sets->Set): string 68{ 69 sys->print("saveclique, saving %d objects\n", objcount(clique.objects[0])); 70 iob := bufio->create(name, Sys->OWRITE, 8r666); 71 if (iob == nil) 72 return sys->sprint("cannot open %s: %r", name); 73 74 # integrate suspended members with current members 75 # for the archive. 76 77 si := ref Saveinfo(clique, array[memberids.limit()] of int, memberids); 78 members := clique.members(); 79 pa := array[len members] of (string, int); 80 for (i := 0; members != nil; members = tl members) { 81 p := hd members; 82 if (memberids.holds(p.id)) 83 pa[i++] = (p.name, p.id); 84 } 85 pa = pa[0:i]; 86 sortmembers(pa); # ensure members stay in the same order when rearchived. 87 pl: list of string; 88 for (i = len pa - 1; i >= 0; i--) { 89 si.idmap[pa[i].t1] = i; 90 pl = pa[i].t0 :: pl; 91 } 92 iob.puts(quotedc("session" :: clique.archive.argv, Qc)); 93 iob.putc('\n'); 94 iob.puts(quotedc("members" :: pl, Qc)); 95 iob.putc('\n'); 96 il: list of string; 97 for (; info != nil; info = tl info) 98 il = (hd info).t0 :: (hd info).t1 :: il; 99 iob.puts(quotedc("info" :: il, Qc)); 100 iob.putc('\n'); 101 writeobject(iob, 0, si, clique.objects[0]); 102 iob.close(); 103 return nil; 104} 105 106writeobject(iob: ref Iobuf, depth: int, si: ref Saveinfo, obj: ref Object) 107{ 108 indent(iob, depth); 109 iob.puts(quotedc(obj.objtype :: nil, Qc)); 110 iob.putc(' '); 111 iob.puts(mapset(si, obj.visibility).str()); 112 writeattrs(iob, si, obj); 113 if (len obj.children > 0) { 114 iob.puts(" {\n"); 115 for (i := 0; i < len obj.children; i++) 116 writeobject(iob, depth + 1, si, obj.children[i]); 117 indent(iob, depth); 118 iob.puts("}\n"); 119 } else 120 iob.putc('\n'); 121} 122 123writeattrs(iob: ref Iobuf, si: ref Saveinfo, obj: ref Object) 124{ 125 a := obj.attrs.a; 126 n := 0; 127 for (i := 0; i < len a; i++) 128 n += len a[i]; 129 attrs := array[n] of ref Attribute; 130 j := 0; 131 for (i = 0; i < len a; i++) 132 for (l := a[i]; l != nil; l = tl l) 133 attrs[j++] = hd l; 134 sortattrs(attrs); 135 for (i = 0; i < len attrs; i++) { 136 attr := attrs[i]; 137 if (attr.val == nil) 138 continue; 139 iob.putc(' '); 140 iob.puts(quotedc(attr.name :: nil, Qc)); 141 vis := mapset(si, attr.visibility); 142 if (!vis.eq(All)) 143 iob.puts("{" + vis.str() + "}"); 144 iob.putc('='); 145 iob.puts(quotedc(attr.val :: nil, Qc)); 146 } 147} 148 149mapset(si: ref Saveinfo, s: Set): Set 150{ 151 idmap := si.idmap; 152 m := s.msb() != 0; 153 limit := si.memberids.limit(); 154 r := None; 155 for (i := 0; i < limit; i++) 156 if (m == !s.holds(i)) 157 r = r.add(idmap[i]); 158 if (m) 159 r = All.X(A&~B, r); 160 return r; 161} 162 163readheader(filename: string): (ref Archive, string) 164{ 165 iob := bufio->open(filename, Sys->OREAD); 166 if (iob == nil) 167 return (nil, sys->sprint("cannot open '%s': %r", filename)); 168 gp := ref Cliqueparse(iob, 1, filename, Bufio->EOF, nil); 169 170 { 171 line := gp.getline(); 172 if (len line < 2 || hd line != "session") 173 gp.error("expected 'session' line, got " + str->quoted(line)); 174 argv := tl line; 175 line = gp.getline(); 176 if (line == nil || tl line == nil || hd line != "members") 177 gp.error("expected 'members' line"); 178 members := l2a(tl line); 179 line = gp.getline(); 180 if (line == nil || hd line != "info") 181 gp.error("expected 'info' line"); 182 if (len tl line % 2 != 0) 183 gp.error("'info' line must have an even number of fields"); 184 info: list of (string, string); 185 for (line = tl line; line != nil; line = tl tl line) 186 info = (hd line, hd tl line) :: info; 187 arch := ref Archive(argv, members, info, nil); 188 iob.close(); 189 return (arch, nil); 190 } exception e { 191 Error => 192 return (nil, x := e); 193 } 194} 195 196read(filename: string): (ref Archive, string) 197{ 198 iob := bufio->open(filename, Sys->OREAD); 199 if (iob == nil) 200 return (nil, sys->sprint("cannot open '%s': %r", filename)); 201 gp := ref Cliqueparse(iob, 1, filename, Bufio->EOF, nil); 202 203 { 204 line := gp.getline(); 205 if (len line < 2 || hd line != "session") 206 gp.error("expected 'session' line, got " + str->quoted(line)); 207 argv := tl line; 208 line = gp.getline(); 209 if (line == nil || tl line == nil || hd line != "members") 210 gp.error("expected 'members' line"); 211 members := l2a(tl line); 212 line = gp.getline(); 213 if (line == nil || hd line != "info") 214 gp.error("expected 'info' line"); 215 if (len tl line % 2 != 0) 216 gp.error("'info' line must have an even number of fields"); 217 info: list of (string, string); 218 for (line = tl line; line != nil; line = tl tl line) 219 info = (hd line, hd tl line) :: info; 220 root := readobject(gp); 221 if (root == nil) 222 return (nil, filename + ": no root object found"); 223 n := objcount(root); 224 arch := ref Archive(argv, members, info, array[n] of ref Object); 225 arch.objects[0] = root; 226 root.parentid = -1; 227 root.id = 0; 228 allocobjects(root, arch.objects, 1); 229 iob.close(); 230 return (arch, nil); 231 } exception e { 232 Error => 233 return (nil, x := e); 234 } 235} 236 237allocobjects(parent: ref Object, objects: array of ref Object, n: int): int 238{ 239 base := n; 240 children := parent.children; 241 objects[n:] = children; 242 n += len children; 243 for (i := 0; i < len children; i++) { 244 child := children[i]; 245 (child.id, child.parentid) = (base + i, parent.id); 246 n = allocobjects(child, objects, n); 247 } 248 return n; 249} 250 251objcount(o: ref Object): int 252{ 253 n := 1; 254 a := o.children; 255 for (i := 0; i < len a; i++) 256 n += objcount(a[i]); 257 return n; 258} 259 260readobject(gp: ref Cliqueparse): ref Object raises (Error) 261{ 262 { 263 # object format: 264 # objtype visibility [attr[{vis}]=val]... [{\nchildren\n}]\n 265 (t, s) := gp.gettok(); #{ 266 if (t == Bufio->EOF || t == '}') 267 return nil; 268 if (t != WORD) 269 gp.error("expected WORD"); 270 objtype := s; 271 vis := sets->str2set(gp.lgettok(WORD)); 272 attrs := Attributes.new(); 273 objs: array of ref Object; 274 loop: for (;;) { 275 (t, s) = gp.gettok(); 276 case t { 277 WORD => 278 attr := s; 279 attrvis := All; 280 (t, s) = gp.gettok(); 281 if (t == '{') { #} 282 attrvis = sets->str2set(gp.lgettok(WORD)); #{ 283 gp.lgettok('}'); 284 gp.lgettok('='); 285 } else if (t != '=') 286 gp.error("expected '='"); 287 val := gp.lgettok(WORD); 288 attrs.set(attr, val, attrvis); 289 '{' => #} 290 gp.lgettok('\n'); 291 objl: list of ref Object; 292 while ((obj := readobject(gp)) != nil) 293 objl = obj :: objl; 294 n := len objl; 295 objs = array[n] of ref Object; 296 for (n--; n >= 0; n--) 297 (objs[n], objl) = (hd objl, tl objl); 298 gp.lgettok('\n'); 299 break loop; 300 '\n' => 301 break loop; 302 * => 303 gp.error("expected WORD or '{'"); #} 304 } 305 } 306 return ref Object(-1, attrs, vis, -1, objs, -1, objtype); 307 } exception e {Error => raise e;} 308} 309 310Cliqueparse.error(gp: self ref Cliqueparse, e: string) raises (Error) 311{ 312 raise Error(sys->sprint("%s:%d: parse error after %s: %s", gp.filename, gp.line, 313 tok2str(gp.lasttok), e)); 314} 315 316Cliqueparse.getline(gp: self ref Cliqueparse): list of string raises (Error) 317{ 318 { 319 line, nline: list of string; 320 for (;;) { 321 (t, s) := gp.gettok(); 322 if (t == '\n') 323 break; 324 if (t != WORD) 325 gp.error("expected a WORD"); 326 line = s :: line; 327 } 328 for (; line != nil; line = tl line) 329 nline = hd line :: nline; 330 return nline; 331 } exception e {Error => raise e;} 332} 333 334# get a token, which must be of type t. 335Cliqueparse.lgettok(gp: self ref Cliqueparse, mustbe: int): string raises (Error) 336{ 337 { 338 (t, s) := gp.gettok(); 339 if (t != mustbe) 340 gp.error("lgettok expected " + tok2str(mustbe)); 341 return s; 342 } exception e {Error => raise e;} 343 344} 345 346Cliqueparse.gettok(gp: self ref Cliqueparse): (int, string) raises (Error) 347{ 348 { 349 iob := gp.iob; 350 while ((c := iob.getc()) == ' ' || c == '\t') 351 ; 352 t: int; 353 s: string; 354 case c { 355 Bufio->EOF or 356 Bufio->ERROR => 357 t = Bufio->EOF; 358 '\n' => 359 gp.line++; 360 t = '\n'; 361 '{' => 362 t = '{'; 363 '}' => 364 t = '}'; 365 '=' => 366 t = '='; 367 '\'' => 368 for(;;) { 369 while ((nc := iob.getc()) != '\'' && nc >= 0) { 370 s[len s] = nc; 371 if (nc == '\n') 372 gp.line++; 373 } 374 if (nc == Bufio->EOF || nc == Bufio->ERROR) 375 gp.error("unterminated quote"); 376 if (iob.getc() != '\'') { 377 iob.ungetc(); 378 break; 379 } 380 s[len s] = '\''; # 'xxx''yyy' becomes WORD(xxx'yyy) 381 } 382 t = WORD; 383 * => 384 do { 385 s[len s] = c; 386 c = iob.getc(); 387 if (in(c, Qc)) { 388 iob.ungetc(); 389 break; 390 } 391 } while (c >= 0); 392 t = WORD; 393 } 394 gp.lasttok = t; 395 return (t, s); 396 } exception e {Error => raise e;} 397} 398 399tok2str(t: int): string 400{ 401 case t { 402 Bufio->EOF => 403 return "EOF"; 404 WORD => 405 return "WORD"; 406 '\n' => 407 return "'\\n'"; 408 * => 409 return sys->sprint("'%c'", t); 410 } 411} 412 413# stolen from lib/string.b - should be part of interface in string.m 414quotedc(argv: list of string, cl: string): string 415{ 416 s := ""; 417 while (argv != nil) { 418 arg := hd argv; 419 for (i := 0; i < len arg; i++) { 420 c := arg[i]; 421 if (c == ' ' || c == '\t' || c == '\n' || c == '\'' || in(c, cl)) 422 break; 423 } 424 if (i < len arg || arg == nil) { 425 s += "'" + arg[0:i]; 426 for (; i < len arg; i++) { 427 if (arg[i] == '\'') 428 s[len s] = '\''; 429 s[len s] = arg[i]; 430 } 431 s[len s] = '\''; 432 } else 433 s += arg; 434 if (tl argv != nil) 435 s[len s] = ' '; 436 argv = tl argv; 437 } 438 return s; 439} 440 441in(c: int, cl: string): int 442{ 443 n := len cl; 444 for (i := 0; i < n; i++) 445 if (cl[i] == c) 446 return 1; 447 return 0; 448} 449 450indent(iob: ref Iobuf, depth: int) 451{ 452 for (i := 0; i < depth; i++) 453 iob.putc('\t'); 454} 455 456sortmembers(p: array of (string, int)) 457{ 458 membermergesort(p, array[len p] of (string, int)); 459} 460 461membermergesort(a, b: array of (string, int)) 462{ 463 r := len a; 464 if (r > 1) { 465 m := (r-1)/2 + 1; 466 membermergesort(a[0:m], b[0:m]); 467 membermergesort(a[m:], b[m:]); 468 b[0:] = a; 469 for ((i, j, k) := (0, m, 0); i < m && j < r; k++) { 470 if (b[i].t1 > b[j].t1) 471 a[k] = b[j++]; 472 else 473 a[k] = b[i++]; 474 } 475 if (i < m) 476 a[k:] = b[i:m]; 477 else if (j < r) 478 a[k:] = b[j:r]; 479 } 480} 481 482sortattrs(a: array of ref Attribute) 483{ 484 attrmergesort(a, array[len a] of ref Attribute); 485} 486 487attrmergesort(a, b: array of ref Attribute) 488{ 489 r := len a; 490 if (r > 1) { 491 m := (r-1)/2 + 1; 492 attrmergesort(a[0:m], b[0:m]); 493 attrmergesort(a[m:], b[m:]); 494 b[0:] = a; 495 for ((i, j, k) := (0, m, 0); i < m && j < r; k++) { 496 if (b[i].name > b[j].name) 497 a[k] = b[j++]; 498 else 499 a[k] = b[i++]; 500 } 501 if (i < m) 502 a[k:] = b[i:m]; 503 else if (j < r) 504 a[k:] = b[j:r]; 505 } 506} 507 508l2a(l: list of string): array of string 509{ 510 n := len l; 511 a := array[n] of string; 512 for (i := 0; i < n; i++) 513 (a[i], l) = (hd l, tl l); 514 return a; 515}