monotone

monotone Mtn Source Tree

Root/mtn-tester

1#!/usr/bin/perl
2
3# <UPDATE> - You may need to comment the next line out or change it to where
4# you have the Monotone::AutomateStdio library installed.
5
6use lib "<Location Of Monotone::AutomateStdio>";
7
8use strict;
9use warnings;
10
11use Carp qw(cluck);
12use File::Basename;
13use POSIX qw(strftime);
14use Storable;
15use Data::Dumper;
16use GDBM_File;
17use IO::File;
18use IO::Handle;
19use Monotone::AutomateStdio qw(:capabilities :severities :streams);
20use Data::Dumper;
21
22use constant RAW => 0;
23use constant LIST => 1;
24use constant RECORD_LIST => 2;
25use constant RECORD => 3;
26use constant CODE => 4;
27use constant VARIABLE => 5;
28
29# <UPDATE> - Enter your key id in the line below.
30
31my $key_id = '<Key Id>';
32
33my($data,
34 %hash,
35 @list,
36 $mtn);
37
38my @test_list =
39 ({fn => \&Monotone::AutomateStdio::ancestors,
40 desc => "ancestors",
41 type => LIST,
42 args => ["f06e40cb1d2b4f5c0db387e7a6c37681f1f89294",
43 "b8e6b77245cf29caa1f69bfb13749d785b13eac7"]},
44
45 {fn => \&Monotone::AutomateStdio::ancestry_difference,
46 desc => "ancestry_difference",
47 type => LIST,
48 args => ["f06e40cb1d2b4f5c0db387e7a6c37681f1f89294",
49 "b8e6b77245cf29caa1f69bfb13749d785b13eac7"]},
50
51 {fn => \&Monotone::AutomateStdio::branches,
52 desc => "branches",
53 type => LIST,
54 args => []},
55
56 {fn => undef,
57 desc => "cert",
58 type => CODE,
59 code => sub {
60 $mtn->cert("f06e40cb1d2b4f5c0db387e7a6c37681f1f89294",
61 "daleks",
62 "exterminate!");
63 printf("Added the daleks cert\n");
64 }},
65
66 {fn => \&Monotone::AutomateStdio::certs,
67 desc => "certs",
68 type => RECORD_LIST,
69 args => ["f06e40cb1d2b4f5c0db387e7a6c37681f1f89294"]},
70
71 {fn => \&Monotone::AutomateStdio::children,
72 desc => "children",
73 type => LIST,
74 args => ["95c9125530ea297d244b522426997942635d3891"]},
75
76 {fn => \&Monotone::AutomateStdio::common_ancestors,
77 desc => "common_ancestors",
78 type => LIST,
79 args => ["f06e40cb1d2b4f5c0db387e7a6c37681f1f89294",
80 "b8e6b77245cf29caa1f69bfb13749d785b13eac7"]},
81
82 {fn => \&Monotone::AutomateStdio::content_diff,
83 desc => "content_diff (revision)",
84 type => RAW,
85 args => [[],
86 "9b264ec9247ce99cd1fdc5293e869c1a60b01c4c",
87 "f06e40cb1d2b4f5c0db387e7a6c37681f1f89294"]},
88
89 {fn => \&Monotone::AutomateStdio::content_diff,
90 desc => "content_diff (file)",
91 type => RAW,
92 args => [[],
93 "9b264ec9247ce99cd1fdc5293e869c1a60b01c4c",
94 "f06e40cb1d2b4f5c0db387e7a6c37681f1f89294",
95 "Makefile.am"]},
96
97 {fn => \&Monotone::AutomateStdio::content_diff,
98 desc => "content_diff (file - options excluding options.cc)",
99 type => RAW,
100 args => [[exclude => "options.cc"],
101 "9b264ec9247ce99cd1fdc5293e869c1a60b01c4c",
102 "f06e40cb1d2b4f5c0db387e7a6c37681f1f89294"]},
103
104 {fn => \&Monotone::AutomateStdio::content_diff,
105 desc => "content_diff (file - options excluding options.cc)",
106 feat => MTN_CONTENT_DIFF_EXTRA_OPTIONS,
107 type => RAW,
108 args => [[exclude => "options.cc",
109"with-header"],
110 "9b264ec9247ce99cd1fdc5293e869c1a60b01c4c",
111 "f06e40cb1d2b4f5c0db387e7a6c37681f1f89294"]},
112
113 {fn => \&Monotone::AutomateStdio::db_get,
114 desc => "db_get",
115 feat => MTN_DB_GET,
116 type => CODE,
117 code => sub {
118 my $value;
119 print("Adding database default-server variable.\n");
120 $mtn->db_set("database", "default-server", "www.test.com");
121 $mtn->db_get(\$value, "database", "default-server");
122 printf("database default-server = `%s'\n", $value);
123 }},
124
125 {fn => \&Monotone::AutomateStdio::descendents,
126 desc => "descendents",
127 type => LIST,
128 args => ["95c9125530ea297d244b522426997942635d3891"]},
129
130 {fn => \&Monotone::AutomateStdio::drop_attribute,
131 desc => "drop_attribute",
132 feat => MTN_DROP_ATTRIBUTE,
133 type => CODE,
134 code => sub {
135 $mtn->drop_attribute("contrib/dtrace2calltree.py",
136 "mtn:execute");
137 $mtn->drop_attribute("contrib/colorize");
138 print("Dropped attributes on contrib/dtrace2calltree.py and "
139. "contrib/colorize\n");
140 }},
141
142 {fn => \&Monotone::AutomateStdio::drop_db_variables,
143 desc => "drop_db_variables",
144 feat => MTN_DROP_DB_VARIABLES,
145 type => CODE,
146 code => sub {
147 print("Adding test variables.\n");
148 $mtn->set_db_variable("test-vars", "var1", "hello");
149 $mtn->set_db_variable("test-vars", "var2", "good bye");
150 $mtn->set_db_variable("TST-vars",
151"greeting",
152"good day");
153 system("mtn ls vars");
154 print("Removing all TST-vars variables and "
155. "test-vars:var1.\n");
156 $mtn->drop_db_variables("TST-vars");
157 $mtn->drop_db_variables("test-vars", "var1");
158 system("mtn ls vars");
159 print("Removing all test-vars variables.\n");
160 $mtn->drop_db_variables("test-vars");
161 system("mtn ls vars");
162 }},
163
164 {fn => \&Monotone::AutomateStdio::erase_ancestors,
165 desc => "erase_ancestors",
166 type => LIST,
167 args => ["05cb265ad778107218701fa76a91bdf4770b85a8",
168 "110816e646d42ca45e8205778255cece9c8f2159",
169 "95c9125530ea297d244b522426997942635d3891"]},
170
171 {fn => \&Monotone::AutomateStdio::file_merge,
172 desc => "file_merge (on a mergeable conflict)",
173 feat => MTN_FILE_MERGE,
174 type => RAW,
175 args => ["05cb265ad778107218701fa76a91bdf4770b85a8",
176 "Makefile.am",
177 "110816e646d42ca45e8205778255cece9c8f2159",
178 "Makefile.am"]},
179
180 {fn => \&Monotone::AutomateStdio::file_merge,
181 desc => "file_merge (on an unmergeable conflict)",
182 feat => MTN_FILE_MERGE,
183 type => RAW,
184 args => ["5fee1e9c463d3cd7439bea9c483d9d88d0b057d5",
185 "ui.cc",
186 "b9a5862a8ba577538f27c69656d8a6bb60ecb777",
187 "ui.cc"]},
188
189 {fn => \&Monotone::AutomateStdio::genkey,
190 desc => "genkey",
191 type => RECORD,
192 args => ["pooh.bear_XxX_1234\@test-id.com",
193 "little brain"]},
194
195 {fn => \&Monotone::AutomateStdio::get_attributes,
196 desc => "get_attributes (on a file that has none)",
197 type => RECORD_LIST,
198 args => ["NEWS"]},
199
200 {fn => \&Monotone::AutomateStdio::get_attributes,
201 desc => "get_attributes (on a file that now has none)",
202 type => RECORD_LIST,
203 args => ["contrib/dtrace2calltree.py"]},
204
205 {fn => \&Monotone::AutomateStdio::get_attributes,
206 desc => "get_attributes (on a file that has a few)",
207 feat => MTN_DROP_DB_VARIABLES,
208 type => RECORD_LIST,
209 args => ["snowdonia.xcf"]},
210
211 {fn => \&Monotone::AutomateStdio::get_base_revision_id,
212 desc => "get_base_revision_id",
213 type => VARIABLE,
214 args => []},
215
216 {fn => \&Monotone::AutomateStdio::get_content_changed,
217 desc => "get_content_changed",
218 type => LIST,
219 args => ["ec5d40149421cbd1b6984de0806d323f9e1e6e60",
220 "Makefile.am"]},
221
222 {fn => \&Monotone::AutomateStdio::get_corresponding_path,
223 desc => "get_corresponding_path",
224 type => VARIABLE,
225 args => ["3db17c6db8b05b11950caec36116e5f0cc518f82",
226 "work.cc",
227 "95c9125530ea297d244b522426997942635d3891"]},
228
229 {fn => \&Monotone::AutomateStdio::get_current_revision,
230 desc => "get_current_revision (no options)",
231 feat => MTN_GET_CURRENT_REVISION,
232 prec => sub {
233 system("mtn rm work.hh");
234 system("mtn rm unix/README");
235 system("cp ../COPYING vocab.hh");
236 system("cp ../COPYING NEW.txt");
237 system("mtn add NEW.txt");
238 },
239 posc => sub {
240 system("mtn --quiet revert .");
241 system("rm NEW.txt");
242 },
243 type => RECORD_LIST,
244 args => []},
245
246 {fn => \&Monotone::AutomateStdio::get_current_revision,
247 desc => "get_current_revision (file restriction)",
248 feat => MTN_GET_CURRENT_REVISION,
249 prec => sub {
250 system("mtn rm work.hh");
251 system("mtn rm unix/README");
252 system("cp ../COPYING vocab.hh");
253 system("cp ../COPYING NEW.txt");
254 system("mtn add NEW.txt");
255 },
256 posc => sub {
257 system("mtn --quiet revert .");
258 system("rm NEW.txt");
259 },
260 type => RECORD_LIST,
261 args => [[],
262 "NEW.txt"]},
263
264 {fn => \&Monotone::AutomateStdio::get_current_revision,
265 desc => "get_current_revision (file restriction and depth option)",
266 feat => MTN_GET_CURRENT_REVISION,
267 prec => sub {
268 system("mtn rm work.hh");
269 system("mtn rm unix/README");
270 system("cp ../COPYING vocab.hh");
271 system("cp ../COPYING NEW.txt");
272 system("mtn add NEW.txt");
273 },
274 posc => sub {
275 system("mtn --quiet revert .");
276 system("rm NEW.txt");
277 },
278 type => RECORD_LIST,
279 args => [["depth" => 1],
280 "NEW.txt"]},
281
282 {fn => \&Monotone::AutomateStdio::get_current_revision,
283 desc => "get_current_revision (exclude option)",
284 feat => MTN_GET_CURRENT_REVISION,
285 prec => sub {
286 system("mtn rm work.hh");
287 system("mtn rm unix/README");
288 system("cp ../COPYING vocab.hh");
289 system("cp ../COPYING NEW.txt");
290 system("mtn add NEW.txt");
291 },
292 posc => sub {
293 system("mtn --quiet revert .");
294 system("rm NEW.txt");
295 },
296 type => RECORD_LIST,
297 args => [["exclude" => "vocab.hh"]]},
298
299 {fn => \&Monotone::AutomateStdio::get_current_revision,
300 desc => "get_current_revision (depth and exclude option)",
301 feat => MTN_GET_CURRENT_REVISION,
302 prec => sub {
303 system("mtn rm work.hh");
304 system("mtn rm unix/README");
305 system("cp ../COPYING vocab.hh");
306 system("cp ../COPYING NEW.txt");
307 system("mtn add NEW.txt");
308 },
309 posc => sub {
310 system("mtn --quiet revert .");
311 system("rm NEW.txt");
312 },
313 type => RECORD_LIST,
314 args => [["depth" => 1,
315"exclude" => "vocab.hh"]]},
316
317 {fn => \&Monotone::AutomateStdio::get_current_revision_id,
318 desc => "get_current_revision_id",
319 type => VARIABLE,
320 args => []},
321
322 {fn => \&Monotone::AutomateStdio::get_db_name,
323 desc => "get_db_name",
324 type => CODE,
325 code => sub {
326 printf("Database name = `%s'\n",
327 defined($mtn->get_db_name())
328 ? $mtn->get_db_name() : "<Workspace>");
329 }},
330
331 {fn => \&Monotone::AutomateStdio::get_db_variables,
332 desc => "get_db_variables",
333 feat => MTN_GET_DB_VARIABLES,
334 type => RECORD_LIST,
335 prec => sub {
336 my @list;
337 print("Adding test variables.\n");
338 $mtn->set_db_variable("test-vars", "var1", "hello");
339 $mtn->set_db_variable("test-vars", "var2", "good bye");
340 $mtn->set_db_variable("TST-vars",
341"greeting",
342"good day");
343 system("mtn ls vars");
344 },
345 posc => sub {
346 print("Removing all test-vars and TST-vars variables.\n");
347 $mtn->drop_db_variables("test-vars");
348 $mtn->drop_db_variables("TST-vars");
349 }},
350
351 {fn => \&Monotone::AutomateStdio::get_file,
352 desc => "get_file (fetching the COPYING file)",
353 type => RAW,
354 args => ["7d7e3bd4448ca5450c1a211675734ed6a5eae18a"]},
355
356 {fn => \&Monotone::AutomateStdio::get_file_of,
357 desc => "get_file_of (fetching the INSTALL file)",
358 type => RAW,
359 args => ["INSTALL",
360 "ec5d40149421cbd1b6984de0806d323f9e1e6e60"]},
361
362 {fn => \&Monotone::AutomateStdio::get_manifest_of,
363 desc => "get_manifest_of",
364 type => RECORD_LIST,
365 args => ["ec5d40149421cbd1b6984de0806d323f9e1e6e60"]},
366
367 {fn => \&Monotone::AutomateStdio::get_option,
368 desc => "get_option (getting the branch option value)",
369 type => VARIABLE,
370 args => ["branch"]},
371
372 {fn => \&Monotone::AutomateStdio::get_pid,
373 desc => "get_pid",
374 type => CODE,
375 code => sub {
376 printf("MTN process id = `%d'\n", $mtn->get_pid());
377 }},
378
379 {fn => \&Monotone::AutomateStdio::get_revision,
380 desc => "get_revision",
381 type => RECORD_LIST,
382 args => ["ec5d40149421cbd1b6984de0806d323f9e1e6e60"]},
383
384 {fn => \&Monotone::AutomateStdio::get_workspace_root,
385 desc => "get_workspace_root",
386 feat => MTN_GET_WORKSPACE_ROOT,
387 type => VARIABLE,
388 args => []},
389
390 {fn => \&Monotone::AutomateStdio::graph,
391 desc => "graph",
392 type => RECORD_LIST,
393 args => []},
394
395 {fn => \&Monotone::AutomateStdio::heads,
396 desc => "heads",
397 type => LIST,
398 args => ["net.venge.monotone.contrib.lib.automate-stdio.test"]},
399
400 {fn => \&Monotone::AutomateStdio::identify,
401 desc => "identify (file database.cc)",
402 type => VARIABLE,
403 args => ["database.cc"]},
404
405 {fn => \&Monotone::AutomateStdio::inventory,
406 desc => "inventory (no options)",
407 type => RECORD_LIST,
408 args => []},
409
410 {fn => \&Monotone::AutomateStdio::inventory,
411 desc => "inventory (depth option)",
412 feat => MTN_INVENTORY_TAKING_OPTIONS,
413 type => RECORD_LIST,
414 args => [["depth" => 1]]},
415
416 {fn => \&Monotone::AutomateStdio::inventory,
417 desc => "inventory (depth + exclude play.cc options)",
418 feat => MTN_INVENTORY_TAKING_OPTIONS,
419 type => RECORD_LIST,
420 args => [["depth" => 1,
421"exclude" => "play.cc"]]},
422
423 {fn => \&Monotone::AutomateStdio::inventory,
424 desc => "inventory (most options)",
425 feat => MTN_INVENTORY_TAKING_OPTIONS,
426 type => RECORD_LIST,
427 args => [["depth" => 1,
428"exclude" => "play.cc",
429"no-corresponding-renames",
430"no-ignored",
431"no-unknown"]]},
432
433 {fn => \&Monotone::AutomateStdio::inventory,
434 desc => "inventory (all options generates nothing)",
435 feat => MTN_INVENTORY_TAKING_OPTIONS,
436 type => RECORD_LIST,
437 args => [["depth" => 1,
438"exclude" => "play.cc",
439"no-corresponding-renames",
440"no-ignored",
441"no-unknown",
442"no-unchanged"],
443 "unix"]},
444
445 {fn => \&Monotone::AutomateStdio::inventory,
446 desc => "inventory (just changed unknown files)",
447 feat => MTN_INVENTORY_TAKING_OPTIONS,
448 type => RECORD_LIST,
449 args => [["no-unchanged"]],
450 prec => sub {
451 system("ls -la > log");
452 system("cp ../COPYING another-file");
453 },
454 posc => sub {
455 system("rm log another-file");
456 }},
457
458 {fn => \&Monotone::AutomateStdio::inventory,
459 desc => "inventory (restrict output to those files under unix)",
460 feat => MTN_INVENTORY_TAKING_OPTIONS,
461 type => RECORD_LIST,
462 args => [[],
463 "unix"]},
464
465 {fn => \&Monotone::AutomateStdio::keys,
466 desc => "keys",
467 type => RECORD_LIST,
468 args => []},
469
470 {fn => \&Monotone::AutomateStdio::leaves,
471 desc => "leaves",
472 type => LIST,
473 args => []},
474
475 {fn => \&Monotone::AutomateStdio::lua,
476 desc => "lua",
477 feat => MTN_LUA,
478 type => RAW,
479 args => ["ignore_file",
480 "'Makefile.am'"]},
481
482 {fn => \&Monotone::AutomateStdio::packet_for_fdata,
483 desc => "packet_for_fdata",
484 type => RAW,
485 args => ["8d87e9368e3f3ebd63df11e12610ac90ac2ee4e5"]},
486
487 {fn => \&Monotone::AutomateStdio::packet_for_fdelta,
488 desc => "packet_for_fdelta",
489 type => RAW,
490 args => ["0682f911f2598d229d218fd28cc5964534bd3c65",
491 "8d87e9368e3f3ebd63df11e12610ac90ac2ee4e5"]},
492
493 {fn => \&Monotone::AutomateStdio::packet_for_rdata,
494 desc => "packet_for_rdata",
495 type => RAW,
496 args => ["ec5d40149421cbd1b6984de0806d323f9e1e6e60"]},
497
498 {fn => \&Monotone::AutomateStdio::packets_for_certs,
499 desc => "packets_for_certs",
500 type => RAW,
501 args => ["ec5d40149421cbd1b6984de0806d323f9e1e6e60"]},
502
503 {fn => \&Monotone::AutomateStdio::parents,
504 desc => "parents",
505 type => RAW,
506 args => ["ec5d40149421cbd1b6984de0806d323f9e1e6e60"]},
507
508 {fn => \&Monotone::AutomateStdio::put_file,
509 desc => "put_file",
510 type => CODE,
511 code => sub {
512 my $data_file = IO::File->new("../COPYING", "r");
513 my($base_rev,
514 $fdata,
515 $file_id,
516 $old_file_id,
517 $rev_data,
518 $rev_id);
519
520 $data_file->sysread($fdata, 64000);
521 $data_file = undef;
522
523 $mtn->put_file(\$file_id, undef, $fdata);
524 printf("Put test-put-file.txt, file id = %s\n", $file_id);
525 $mtn->get_base_revision_id(\$base_rev);
526 $rev_data = "format_version \"1\"\n\n"
527 . "new_manifest "
528 . "[0000000000000000000000000000000000000000]\n\n"
529 . "old_revision [" . $base_rev . "]\n\n"
530 . "add_file \"test-put-file.txt\"\n"
531 . " content [" . $file_id . "]\n";
532 $mtn->put_revision(\$rev_id, $rev_data);
533 $mtn->cert($rev_id, "author", "aecooper\@coosoft.plus.com");
534 $mtn->cert($rev_id,
535 "branch",
536 "net.venge.monotone.contrib.lib.automate-stdio."
537 . "test");
538 $mtn->cert($rev_id, "changelog", "Automated checkin.");
539 $mtn->cert($rev_id, "date", "2008-10-16T18:42:30");
540 printf("Put revision, revision id = %s\n", $rev_id);
541
542 $fdata = substr($fdata, 5);
543 $old_file_id = $file_id;
544 $mtn->put_file(\$file_id, $old_file_id, $fdata);
545 printf("Put modified test-put-file.txt, file id = %s\n",
546 $file_id);
547 $base_rev = $rev_id;
548 $rev_data = "format_version \"1\"\n\n"
549 . "new_manifest "
550 . "[0000000000000000000000000000000000000000]\n\n"
551 . "old_revision [" . $base_rev . "]\n\n"
552 . "patch \"test-put-file.txt\"\n"
553 . " from [" . $old_file_id . "]\n"
554 . " to [" . $file_id . "]\n";
555 $mtn->put_revision(\$rev_id, $rev_data);
556 $mtn->cert($rev_id, "author", "aecooper\@coosoft.plus.com");
557 $mtn->cert($rev_id,
558 "branch",
559 "net.venge.monotone.contrib.lib.automate-stdio."
560 . "test");
561 $mtn->cert($rev_id, "changelog", "Automated checkin #2.");
562 $mtn->cert($rev_id, "date", "2008-10-16T18:42:35");
563 printf("Put revision, revision id = %s\n", $rev_id);
564
565 print("Displaying revision change log:\n");
566 system("mtn update");
567 system("mtn log --last 5 --no-graph");
568 }},
569
570 {fn => undef,
571 desc => "read_packets",
572 feat => MTN_READ_PACKETS,
573 type => CODE,
574 code => sub {
575 $mtn->read_packets
576 ('[pubkey piglet@aamilne.com] '
577 . 'MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDKBEOCGipeYi1/'
578 . 'dVI93aks2jMZbU4PBj2p '
579 . '+gtncni0xEd8MffZ3Zx4FQOsI1PAqVPmNhxA18VKJ0kRg97IUj/'
580 . 'GpsZMFemhEO96mp3tLT29 '
581 . 'F8mW302RlfaXEk7BdP0MXHuRrpXyDJ30YDzUZ+tNqlcgkQTvS+'
582 . 'LfUr/US71/blGDzwIDAQAB '
583 . '[end]');
584 print("Added the piglet\@aamilne.com key\n");
585 system("mtn ls keys");
586 }},
587
588 {fn => \&Monotone::AutomateStdio::roots,
589 desc => "roots",
590 type => LIST,
591 args => []},
592
593 {fn => \&Monotone::AutomateStdio::select,
594 desc => "select",
595 type => LIST,
596 args => ["b:net.venge.monotone.contrib.lib.automate-stdio.test"]},
597
598 {fn => \&Monotone::AutomateStdio::set_attribute,
599 desc => "set_attribute",
600 feat => MTN_SET_ATTRIBUTE,
601 type => CODE,
602 code => sub {
603 $mtn->set_attribute("database.cc",
604 "mtn:test-attr",
605 "this-is-a-test-value");
606 print("Added mtn:test-attr to file database.cc.\n");
607 }},
608
609 {fn => \&Monotone::AutomateStdio::show_conflicts,
610 desc => "show_conflicts",
611 feat => MTN_SHOW_CONFLICTS,
612 type => RECORD_LIST,
613 args => ["26cfbb87b400321bda71277e1d2c0ba1d5e9898f",
614 "15db9bc261c01c4ca5cdb052aec69d29f3bec58a"]},
615
616 {fn => \&Monotone::AutomateStdio::show_conflicts,
617 desc => "show_conflicts (with internal merge resolution)",
618 feat => MTN_SHOW_CONFLICTS,
619 type => RECORD_LIST,
620 args => ["05cb265ad778107218701fa76a91bdf4770b85a8",
621 "110816e646d42ca45e8205778255cece9c8f2159"]},
622
623 {fn => \&Monotone::AutomateStdio::tags,
624 desc => "tags (no branch restrictions)",
625 type => RECORD_LIST,
626 args => []},
627
628 {fn => \&Monotone::AutomateStdio::tags,
629 desc => "tags (with branch restriction)",
630 type => RECORD_LIST,
631 args => ["net.venge.monotone.contrib.lib.automate-stdio.test"]},
632
633 {fn => \&Monotone::AutomateStdio::toposort,
634 desc => "toposort",
635 type => LIST,
636 args => ["b8e6b77245cf29caa1f69bfb13749d785b13eac7",
637 "805c482bc9bb80cd393be7d3ba01a65377d91d9c",
638 "afd43cf2ce01fa4513fb1673eae47be3b48008f6"]},
639
640 {fn => undef,
641 desc => "sync/pull/push",
642 feat => MTN_SYNCHRONISATION,
643 type => CODE,
644 code => sub {
645 foreach my $op ("sync", "pull", "push")
646 {
647 my($p_buffer,
648 $pfh,
649 $t_buffer,
650 $tfh);
651 $p_buffer = $t_buffer = "";
652 open($pfh, ">", \$p_buffer);
653 open($tfh, ">", \$t_buffer);
654 $mtn->register_stream_handle(MTN_P_STREAM, $pfh);
655 $mtn->register_stream_handle(MTN_T_STREAM, $tfh);
656 &{$Monotone::AutomateStdio::{$op}}($mtn,
657 [],
658 "localhost",
659 "*");
660 $mtn->register_stream_handle(MTN_P_STREAM, undef);
661 $mtn->register_stream_handle(MTN_T_STREAM, undef);
662 $pfh->close();
663 $tfh->close();
664 print(" ----- Output of $op progress stream -----\n");
665 print($p_buffer);
666 print("\n ----------\n");
667 print(" ----- Output of $op ticker stream -----\n");
668 print($t_buffer);
669 print("\n ----------\n");
670 }
671 $mtn->drop_db_variables("database");
672 $mtn->drop_db_variables("known-servers");
673 }},
674
675 {fn => undef,
676 desc => "remote connections (getting a branch listing)",
677 feat => MTN_REMOTE_CONNECTIONS,
678 type => CODE,
679 code => sub {
680 my(@branches,
681 $rmtn);
682 $rmtn = Monotone::AutomateStdio->
683 new_from_service("localhost", ["--key" => $key_id]);
684 $rmtn->branches(\@branches);
685 foreach my $branch (@branches)
686 {
687 print($branch . "\n");
688 }
689 }},
690
691 {fn => undef,
692 desc => "update",
693 feat => MTN_UPDATE,
694 type => CODE,
695 code => sub {
696 foreach my $op ([revision => "i:1d8d91f5976860dbcabe209829ff"
697 . "2e34d8119a58"],
698 [branch => "net.venge.monotone",
699 revision => "i:c2de1dbfe651d26a0d0a33d43c50"
700 . "444583c5dad8"],
701 [branch => "net.venge.monotone.contrib.lib"
702 . ".automate-stdio.test",
703 revision => "h:"])
704 {
705 my($p_buffer,
706 $pfh,
707 $t_buffer,
708 $tfh);
709 $p_buffer = $t_buffer = "";
710 open($pfh, ">", \$p_buffer);
711 open($tfh, ">", \$t_buffer);
712 $mtn->register_stream_handle(MTN_P_STREAM, $pfh);
713 $mtn->register_stream_handle(MTN_T_STREAM, $tfh);
714 $mtn->update($op);
715 $mtn->register_stream_handle(MTN_P_STREAM, undef);
716 $mtn->register_stream_handle(MTN_T_STREAM, undef);
717 $pfh->close();
718 $tfh->close();
719 print(" ----- Output of progress stream -----\n");
720 print($p_buffer);
721 print("\n ----------\n");
722 print(" ----- Output of ticker stream -----\n");
723 print($t_buffer);
724 print("\n ----------\n");
725 }
726 }});
727
728print <<EOF;
729Monotone::AutomateStdio Test Harness Script
730
731NOTE:
7321) This test harness needs a copy of the venge.net database and specifically
733 the net.venge.monotone.contrib.lib.automate-stdio.test branch. It also needs
734 a Monotone server on the local machine for automate remote_stdio testing if
735 the version of Monotone is above 0.45.
736
7372) WARNING: This test harness does modify the database by adding some
738 revisions. Do not sync these changes back into any proper database. Please
739 take a copy of a good database and remove all database variables by using
740 the mtn unset command.
741
7423) This script will probably need to be modified to make it work in your
743 environment. Look for <UPDATE> tokens in the source code for pointers as to
744 what may need to change.
745
7464) Do not come complaining to me when you use this script and it trashes
747 something. You should always make backup copies anyway. :-).
748
749Ctrl-C now if you do not like the above!
750
751Tony Cooper.
752
753[Press <Return> to start the tests]
754EOF
755readline(STDIN);
756
757Monotone::AutomateStdio->suppress_utf8_conversion(1);
758$mtn = Monotone::AutomateStdio->new(["--key" => $key_id]);
759
760$data = undef;
761if ($mtn->supports(MTN_DB_GET))
762{
763 $data = undef if (! $mtn->db_get(\$data, "database", "default-server"));
764}
765else
766{
767 my @list;
768 $mtn->get_db_variables(\@list, "database");
769 foreach my $entry (@list)
770 {
771if ($entry->{name} eq "default-server")
772{
773 $data = $entry->{value};
774 last;
775}
776 }
777}
778die("Your test database will sync to `" . $data . "' - this is unsafe")
779 if (defined($data));
780
781# Clear out any error state created from the above tests.
782
783$mtn = undef;
784$mtn = Monotone::AutomateStdio->new(["--key" => $key_id]);
785
786Monotone::AutomateStdio->register_error_handler
787 (MTN_SEVERITY_ALL,
788 sub
789 {
790 my($severity, $message) = @_;
791 printf(STDERR "\n\n====================\nPROBLEM (%s): %s\n",
792$severity, $message);
793 cluck();
794 });
795
796foreach my $test (@test_list)
797{
798 if (! exists($test->{feat}) || $mtn->supports($test->{feat}))
799 {
800printf(" ========== %s ==========\n", $test->{desc});
801if (exists($test->{prec}))
802{
803 $test->{prec}();
804}
805if ($test->{type} == RAW)
806{
807 if (! $test->{fn}($mtn, \$data, @{$test->{args}}))
808 {
809printf(STDERR "OOPS: %s\n", $mtn->get_error_message());
810 }
811 else
812 {
813print($data);
814 }
815}
816elsif ($test->{type} == LIST)
817{
818 if (! $test->{fn}($mtn, \@list, @{$test->{args}}))
819 {
820printf(STDERR "OOPS: %s\n", $mtn->get_error_message());
821 }
822 else
823 {
824print(Dumper(\@list));
825 }
826}
827elsif ($test->{type} == RECORD)
828{
829 if (! $test->{fn}($mtn, \%hash, @{$test->{args}}))
830 {
831printf(STDERR "OOPS: %s\n", $mtn->get_error_message());
832 }
833 else
834 {
835print(Dumper(\%hash));
836 }
837}
838elsif ($test->{type} == RECORD_LIST)
839{
840 printf(" ---------- Raw Data ----------\n");
841 if (! $test->{fn}($mtn, \$data, @{$test->{args}}))
842 {
843printf(STDERR "OOPS: %s\n", $mtn->get_error_message());
844 }
845 else
846 {
847print($data);
848 }
849 printf(" ---------- Structured Data ----------\n");
850 if (! $test->{fn}($mtn, \@list, @{$test->{args}}))
851 {
852printf(STDERR "OOPS: %s\n", $mtn->get_error_message());
853 }
854 else
855 {
856print(Dumper(\@list));
857 }
858}
859elsif ($test->{type} == VARIABLE)
860{
861 if (! $test->{fn}($mtn, \$data, @{$test->{args}}))
862 {
863printf(STDERR "OOPS: %s\n", $mtn->get_error_message());
864 }
865 else
866 {
867print("Variable = `" . $data . "'\n");
868 }
869}
870elsif ($test->{type} == CODE)
871{
872 $test->{code}();
873}
874if (exists($test->{posc}))
875{
876 $test->{posc}();
877}
878printf("\nget_error_message() method returned `%s'\n",
879 $mtn->get_error_message());
880 }
881}
882
883printf("Last error message `%s'\n", $mtn->get_error_message());
884print Dumper (\$mtn);
885
886printf("Destroying object.\n");
887$mtn = undef;
888
889exit(0);

Archive Download this file

Branches

Tags

Quick Links:     www.monotone.ca    -     Downloads    -     Documentation    -     Wiki    -     Code Forge    -     Build Status