monotone

monotone Commit Details

Date:2010-02-13 20:19:39 (9 years 3 months ago)
Author:Tony Cooper
Branch:net.venge.monotone.contrib.lib.automate-stdio
Commit:4f30f7cc9793d4182cee25af404f943fabca7bac
Parents: 1a3b6af9f4ec930adf45c930178f4ab31719085a
Message:First stab at Outside In object design.

Changes:
Mlib/Monotone/AutomateStdio.pm (195 diffs)

File differences

lib/Monotone/AutomateStdio.pm
6464
6565
6666
67
6768
6869
6970
......
126127
127128
128129
130
131
132
133
134
135
129136
130137
131138
......
253260
254261
255262
256
263
257264
258265
259266
260267
261268
262269
270
263271
264272
265273
......
338346
339347
340348
341
349
342350
343351
344352
......
429437
430438
431439
440
432441
433442
434443
......
446455
447456
448457
449
458
459
450460
451461
452462
453
454463
455464
456465
457
466
458467
459
468
460469
461470
462471
......
489498
490499
491500
492
501
502
493503
494504
495505
......
511521
512522
513523
514
524
525
515526
516527
517528
518
519529
520530
521531
522
532
523533
524
534
525535
526536
527537
......
556566
557567
558568
569
559570
560571
561572
......
570581
571582
572583
573
584
585
574586
575587
576588
577
578589
579590
580591
581
592
582593
583
594
584595
585596
586597
......
590601
591602
592603
593
604
594605
595606
596607
......
599610
600611
601612
602
613
603614
615
616
604617
605618
606619
......
613626
614627
615628
629
630
616631
617
618
619
620
621
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
622683
623684
624685
......
629690
630691
631692
632
693
633694
634695
635696
......
644705
645706
646707
647
708
648709
649
710
650711
651712
652713
......
657718
658719
659720
660
721
661722
662723
663724
......
674735
675736
676737
677
738
678739
679
740
680741
681742
682743
......
691752
692753
693754
694
755
695756
696757
697758
......
703764
704765
705766
706
767
707768
708
769
709770
710771
711772
......
715776
716777
717778
718
779
719780
720781
721782
......
729790
730791
731792
732
793
733794
734795
735796
736
797
737798
738799
739800
......
749810
750811
751812
752
813
753814
754815
755816
......
763824
764825
765826
766
827
767828
768829
769830
770831
771832
772833
773
834
774835
775836
776837
......
778839
779840
780841
781
842
782843
783844
784845
......
820881
821882
822883
823
884
824885
825886
826887
......
834895
835896
836897
837
898
838899
839
900
840901
841902
842903
......
847908
848909
849910
850
911
851912
852913
853914
......
862923
863924
864925
865
926
866927
867
928
868929
869930
870931
......
880941
881942
882943
883
944
884945
885946
886947
......
899960
900961
901962
902
963
903964
904965
905966
......
927988
928989
929990
930
991
931992
932993
933994
......
9421003
9431004
9441005
945
1006
9461007
9471008
9481009
......
9561017
9571018
9581019
959
1020
9601021
961
1022
9621023
9631024
9641025
......
9681029
9691030
9701031
971
1032
9721033
9731034
9741035
......
9831044
9841045
9851046
986
1047
9871048
988
1049
9891050
9901051
9911052
......
9961057
9971058
9981059
999
1060
10001061
10011062
10021063
......
10101071
10111072
10121073
1013
1074
10141075
10151076
10161077
1017
1078
10181079
10191080
10201081
......
10251086
10261087
10271088
1028
1089
10291090
10301091
10311092
......
10391100
10401101
10411102
1042
1103
10431104
10441105
10451106
1046
1107
10471108
10481109
10491110
......
10591120
10601121
10611122
1062
1123
10631124
10641125
10651126
......
10741135
10751136
10761137
1077
1138
10781139
1079
1140
10801141
10811142
10821143
......
10871148
10881149
10891150
1090
1151
10911152
10921153
10931154
......
11061167
11071168
11081169
1109
1170
11101171
11111172
11121173
11131174
11141175
11151176
1116
1177
11171178
11181179
11191180
......
11301191
11311192
11321193
1133
1194
11341195
11351196
11361197
......
11441205
11451206
11461207
1147
1208
11481209
11491210
11501211
11511212
11521213
11531214
1154
1215
11551216
11561217
11571218
......
11601221
11611222
11621223
1163
1224
11641225
11651226
11661227
......
11971258
11981259
11991260
1200
1261
12011262
12021263
12031264
......
12111272
12121273
12131274
1214
1275
12151276
12161277
12171278
12181279
12191280
1220
1281
12211282
12221283
12231284
......
12311292
12321293
12331294
1234
1295
12351296
12361297
12371298
......
12391300
12401301
12411302
1242
1303
12431304
12441305
12451306
......
12861347
12871348
12881349
1289
1350
12901351
12911352
12921353
......
12981359
12991360
13001361
1301
1362
13021363
13031364
13041365
13051366
1306
1367
13071368
13081369
13091370
......
13201381
13211382
13221383
1323
1384
13241385
13251386
13261387
......
13361397
13371398
13381399
1339
1400
13401401
13411402
13421403
13431404
13441405
13451406
1346
1407
13471408
13481409
13491410
......
13751436
13761437
13771438
1378
1439
13791440
13801441
13811442
......
13921453
13931454
13941455
1395
1456
13961457
13971458
13981459
......
14001461
14011462
14021463
1403
1464
14041465
14051466
14061467
......
14341495
14351496
14361497
1437
1498
14381499
14391500
14401501
......
14511512
14521513
14531514
1454
1515
14551516
14561517
14571518
......
14781539
14791540
14801541
1481
1542
14821543
14831544
14841545
......
14901551
14911552
14921553
1493
1554
14941555
14951556
14961557
......
15141575
15151576
15161577
1517
1578
15181579
15191580
15201581
......
15261587
15271588
15281589
1529
1590
15301591
15311592
15321593
15331594
1534
1595
15351596
15361597
15371598
......
15481609
15491610
15501611
1551
1612
15521613
15531614
15541615
......
15621623
15631624
15641625
1565
1626
15661627
15671628
15681629
15691630
15701631
15711632
1572
1633
15731634
15741635
15751636
......
15801641
15811642
15821643
1583
1644
15841645
15851646
15861647
......
16251686
16261687
16271688
1628
1689
16291690
16301691
16311692
......
16391700
16401701
16411702
1642
1703
16431704
1644
1705
16451706
16461707
16471708
......
16531714
16541715
16551716
1656
1717
16571718
16581719
16591720
......
16681729
16691730
16701731
1671
1732
16721733
16731734
16741735
16751736
16761737
16771738
1678
1739
16791740
16801741
16811742
......
16901751
16911752
16921753
1693
1754
16941755
16951756
16961757
......
17041765
17051766
17061767
1707
1768
17081769
17091770
17101771
17111772
17121773
17131774
1714
1775
17151776
17161777
17171778
......
17251786
17261787
17271788
1728
1789
17291790
17301791
17311792
......
18001861
18011862
18021863
1803
1864
18041865
18051866
18061867
......
18131874
18141875
18151876
1816
1877
18171878
1818
1879
18191880
18201881
18211882
......
18321893
18331894
18341895
1835
1896
18361897
18371898
18381899
......
18461907
18471908
18481909
1849
1910
18501911
18511912
18521913
18531914
18541915
18551916
1856
1917
18571918
18581919
18591920
18601921
18611922
18621923
1863
1924
18641925
18651926
18661927
......
18791940
18801941
18811942
1882
1943
18831944
18841945
18851946
......
18911952
18921953
18931954
1894
1955
18951956
1896
1957
18971958
18981959
18991960
......
19091970
19101971
19111972
1912
1973
19131974
19141975
19151976
......
19211982
19221983
19231984
1924
1985
19251986
19261987
19271988
19281989
19291990
19301991
1931
1992
19321993
19331994
19341995
......
19371998
19381999
19392000
1940
2001
19412002
19422003
19432004
......
19622023
19632024
19642025
1965
2026
19662027
19672028
19682029
......
19762037
19772038
19782039
1979
2040
19802041
1981
2042
19822043
19832044
19842045
......
19882049
19892050
19902051
1991
2052
19922053
19932054
19942055
......
20022063
20032064
20042065
2005
2066
20062067
20072068
20082069
20092070
2010
2071
20112072
20122073
20132074
......
20232084
20242085
20252086
2026
2087
20272088
20282089
20292090
......
20352096
20362097
20372098
2038
2099
20392100
20402101
20412102
20422103
2043
2104
20442105
20452106
20462107
......
20582119
20592120
20602121
2061
2122
20622123
20632124
20642125
......
20752136
20762137
20772138
2078
2139
20792140
20802141
20812142
......
21012162
21022163
21032164
2104
2165
21052166
21062167
21072168
......
21132174
21142175
21152176
2116
2177
21172178
21182179
21192180
......
21262187
21272188
21282189
2129
2190
21302191
21312192
21322193
......
21882249
21892250
21902251
2191
2252
21922253
21932254
21942255
......
22002261
22012262
22022263
2203
2264
22042265
22052266
22062267
22072268
22082269
22092270
2210
2271
22112272
22122273
22132274
......
22162277
22172278
22182279
2219
2280
22202281
22212282
22222283
......
22252286
22262287
22272288
2228
2229
2289
2290
22302291
22312292
22322293
......
22732334
22742335
22752336
2276
2337
22772338
22782339
22792340
......
22852346
22862347
22872348
2288
2349
22892350
2290
2351
22912352
22922353
22932354
......
22982359
22992360
23002361
2301
2362
23022363
23032364
23042365
......
23152376
23162377
23172378
2318
2379
23192380
2320
2381
23212382
23222383
23232384
......
23282389
23292390
23302391
2331
2392
23322393
23332394
23342395
......
23422403
23432404
23442405
2345
2406
23462407
2347
2408
23482409
23492410
23502411
......
23552416
23562417
23572418
2358
2419
23592420
23602421
23612422
......
23722433
23732434
23742435
2375
2436
23762437
2377
2438
23782439
23792440
23802441
......
23902451
23912452
23922453
2393
2454
23942455
23952456
23962457
......
24042465
24052466
24062467
2407
2468
24082469
2409
2470
24102471
24112472
24122473
......
24172478
24182479
24192480
2420
2481
24212482
24222483
24232484
......
24312492
24322493
24332494
2434
2495
24352496
2436
2497
24372498
24382499
24392500
......
24472508
24482509
24492510
2450
2511
24512512
24522513
24532514
......
24612522
24622523
24632524
2464
2525
24652526
2466
2527
24672528
24682529
24692530
......
24752536
24762537
24772538
2478
2539
24792540
24802541
24812542
......
24922553
24932554
24942555
2495
2556
24962557
24972558
24982559
24992560
25002561
2501
2562
25022563
25032564
25042565
......
25102571
25112572
25122573
2513
2574
25142575
25152576
25162577
......
25272588
25282589
25292590
2530
2591
25312592
25322593
25332594
......
25412602
25422603
25432604
2544
2605
25452606
25462607
25472608
2548
2609
25492610
25502611
25512612
......
25612622
25622623
25632624
2564
2625
25652626
25662627
25672628
......
25732634
25742635
25752636
2576
2637
25772638
25782639
25792640
2580
2641
25812642
25822643
25832644
......
25882649
25892650
25902651
2591
2652
25922653
25932654
25942655
......
26002661
26012662
26022663
2603
2664
26042665
2605
2666
26062667
26072668
26082669
......
26132674
26142675
26152676
2616
2677
26172678
26182679
26192680
......
26262687
26272688
26282689
2629
2690
26302691
2631
2692
26322693
26332694
26342695
......
26382699
26392700
26402701
2641
2702
26422703
26432704
26442705
......
26532714
26542715
26552716
2656
2717
26572718
26582719
26592720
2660
2721
26612722
26622723
26632724
......
26732734
26742735
26752736
2676
2737
26772738
26782739
26792740
......
26862747
26872748
26882749
2689
2750
26902751
26912752
26922753
26932754
26942755
26952756
2696
2757
26972758
26982759
26992760
......
27012762
27022763
27032764
2704
2765
27052766
27062767
27072768
......
27142775
27152776
27162777
2717
2778
27182779
27192780
27202781
......
27322793
27332794
27342795
2735
2796
27362797
27372798
2799
27382800
27392801
27402802
......
27692831
27702832
27712833
2772
2834
27732835
27742836
27752837
......
27832845
27842846
27852847
2786
2848
27872849
27882850
27892851
......
28392901
28402902
28412903
2842
2904
28432905
28442906
28452907
......
28562918
28572919
28582920
2859
2921
28602922
28612923
28622924
......
28872949
28882950
28892951
2890
2952
28912953
28922954
28932955
......
28972959
28982960
28992961
2900
2962
29012963
29022964
29032965
......
29102972
29112973
29122974
2913
2975
29142976
29152977
29162978
......
29262988
29272989
29282990
2929
2991
29302992
29312993
29322994
29332995
29342996
29352997
2936
2998
29372999
29383000
29393001
......
29413003
29423004
29433005
2944
3006
29453007
29463008
29473009
......
29923054
29933055
29943056
2995
3057
29963058
29973059
29983060
......
30073069
30083070
30093071
3010
3072
30113073
3012
3074
30133075
30143076
30153077
......
30193081
30203082
30213083
3022
3084
30233085
30243086
30253087
......
30283090
30293091
30303092
3031
3093
30323094
3095
3096
30333097
30343098
30353099
......
31263190
31273191
31283192
3129
3193
31303194
31313195
31323196
......
31373201
31383202
31393203
3140
3204
31413205
3206
3207
31423208
31433209
31443210
......
31503216
31513217
31523218
3153
3219
31543220
31553221
31563222
......
31623228
31633229
31643230
3165
3231
31663232
3233
3234
31673235
31683236
31693237
......
31753243
31763244
31773245
3178
3246
31793247
31803248
31813249
......
31873255
31883256
31893257
3190
3258
31913259
3260
3261
31923262
31933263
31943264
......
31993269
32003270
32013271
3202
3272
32033273
32043274
32053275
......
32113281
32123282
32133283
3214
3284
32153285
3286
3287
32163288
32173289
32183290
......
32293301
32303302
32313303
3232
3304
32333305
32343306
32353307
......
32413313
32423314
32433315
3244
3316
32453317
3318
3319
32463320
32473321
32483322
......
32553329
32563330
32573331
3258
3332
32593333
32603334
32613335
......
32693343
32703344
32713345
3272
3346
32733347
3348
3349
32743350
32753351
32763352
32773353
3278
3354
32793355
32803356
3281
3282
3357
3358
32833359
32843360
32853361
......
32923368
32933369
32943370
3295
3296
3371
3372
32973373
32983374
32993375
......
33103386
33113387
33123388
3313
3389
33143390
33153391
33163392
......
33293405
33303406
33313407
3332
3408
3409
33333410
33343411
33353412
33363413
3337
3414
3415
33383416
33393417
33403418
......
33433421
33443422
33453423
3346
3424
33473425
33483426
33493427
......
33793457
33803458
33813459
3382
3460
33833461
33843462
33853463
......
34633541
34643542
34653543
3466
3544
34673545
34683546
34693547
......
34833561
34843562
34853563
3486
3564
3565
34873566
34883567
34893568
34903569
3491
3570
3571
34923572
34933573
34943574
......
35133593
35143594
35153595
3516
3596
35173597
35183598
35193599
......
35493629
35503630
35513631
3552
3632
35533633
35543634
35553635
......
35653645
35663646
35673647
3568
3648
35693649
3650
3651
35703652
35713653
35723654
......
35943676
35953677
35963678
3597
3679
35983680
35993681
36003682
......
36073689
36083690
36093691
3610
3692
36113693
3694
3695
36123696
36133697
36143698
......
37273811
37283812
37293813
3730
3814
37313815
37323816
37333817
......
37403824
37413825
37423826
3743
3827
3828
37443829
37453830
37463831
37473832
3748
3833
3834
37493835
37503836
37513837
......
37543840
37553841
37563842
3757
3843
37583844
37593845
37603846
......
37743860
37753861
37763862
3777
3863
37783864
37793865
37803866
......
37883874
37893875
37903876
3791
3877
3878
37923879
37933880
37943881
37953882
3796
3883
3884
37973885
37983886
37993887
......
38023890
38033891
38043892
3805
3893
38063894
38073895
38083896
38093897
38103898
38113899
3812
3813
3900
3901
38143902
38153903
38163904
38173905
3818
3819
3906
3907
38203908
38213909
38223910
......
40634151
40644152
40654153
4066
4154
40674155
40684156
40694157
......
40914179
40924180
40934181
4094
4182
40954183
4096
4184
40974185
40984186
40994187
......
41114199
41124200
41134201
4114
4202
41154203
41164204
41174205
......
41414229
41424230
41434231
4144
4232
41454233
41464234
41474235
......
41544242
41554243
41564244
4245
41574246
41584247
41594248
......
41984287
41994288
42004289
4201
4290
42024291
42034292
42044293
......
42814370
42824371
42834372
4284
4373
42854374
42864375
42874376
......
43124401
43134402
43144403
4315
4404
43164405
43174406
43184407
......
43344423
43354424
43364425
4337
4426
43384427
43394428
43404429
......
43434432
43444433
43454434
4346
4435
43474436
43484437
43494438
......
43714460
43724461
43734462
4374
4463
43754464
43764465
43774466
......
43834472
43844473
43854474
4386
4475
43874476
43884477
43894478
......
44014490
44024491
44034492
4493
44044494
44054495
44064496
......
44334523
44344524
44354525
4436
4526
44374527
44384528
44394529
......
45374627
45384628
45394629
4540
4630
45414631
45424632
45434633
......
45494639
45504640
45514641
4552
4642
45534643
45544644
45554645
......
45804670
45814671
45824672
4673
45834674
45844675
45854676
......
46274718
46284719
46294720
4630
4721
46314722
46324723
46334724
......
48154906
48164907
48174908
4818
4909
48194910
48204911
48214912
......
48244915
48254916
48264917
4827
4918
48284919
4920
4921
48294922
48304923
48314924
......
49585051
49595052
49605053
4961
5054
49625055
49635056
49645057
......
49875080
49885081
49895082
4990
5083
49915084
49925085
49935086
......
51495242
51505243
51515244
5152
5245
51535246
5154
5247
51555248
5156
5157
5249
5250
5251
51585252
51595253
51605254
51615255
51625256
5163
5257
51645258
51655259
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5260
51905261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
51915316
51925317
51935318
use IO::Poll qw(POLLHUP POLLIN POLLPRI);
use IPC::Open3;
use POSIX qw(:errno_h);
use Scalar::Util qw(refaddr weaken);
use Socket;
use Symbol qw(gensym);
use constant STRING_ENUM => 0x20; # E.g. "rename_source".
use constant STRING_LIST => 0x40; # E.g. "..." "...", possibly escaped.
# Private structures for managing outside-in style objects.
my $class_name = __PACKAGE__;
my(%class_objects,
%class_records);
# Pre-compiled regular expressions for: finding the end of a quoted string
# possibly containing escaped quotes (i.e. " preceeded by a non-backslash
# character or an even number of backslash characters), recognising data locked
# ***** FUNCTIONAL PROTOTYPES *****
# Constructors and destructor.
# Constructors, destructor and thread cloner.
sub new_from_db($;$$);
sub new_from_service($$;$);
sub new_from_ws($;$$);
*new = *new_from_db;
sub DESTROY($);
sub CLONE();
# Public methods.
# Private methods and routines.
sub create_object_data();
sub create_object($);
sub error_handler_wrapper($);
sub get_quoted_value($$$);
sub get_ws_details($$$);
my($db,
$this,
$self,
$ws_path);
# Check all the arguments given to us.
# Actually construct the object.
$this = create_object_data();
$self = create_object($class);
$this = $class_records{$self->{$class_name}};
$this->{db_name} = $db_name;
$this->{ws_path} = $ws_path;
$this->{mtn_options} = $options;
bless($this, $class);
# Startup the mtn subprocess (also determining the interface version).
$this->startup();
$self->startup();
return $this;
return $self;
}
#
my($service, $options) = @_;
$options = [] unless (defined($options));
my($server,
my($self,
$server,
$this);
# Check all the arguments given to us.
# Actually construct the object.
$this = create_object_data();
$self = create_object($class);
$this = $class_records{$self->{$class_name}};
$this->{db_name} = ":memory:";
$this->{network_service} = $service;
$this->{mtn_options} = $options;
bless($this, $class);
# Startup the mtn subprocess (also determining the interface version).
$this->startup();
$self->startup();
return $this;
return $self;
}
#
$options = [] unless (defined($options));
my($db_name,
$self,
$this);
# Check all the arguments given to us.
# Actually construct the object.
$this = create_object_data();
$self = create_object($class);
$this = $class_records{$self->{$class_name}};
$this->{ws_path} = $ws_path;
$this->{ws_constructed} = 1;
$this->{mtn_options} = $options;
bless($this, $class);
# Startup the mtn subprocess (also determining the interface version).
$this->startup();
$self->startup();
return $this;
return $self;
}
#
#
# Description - Class destructor.
#
# Data - $this : The object.
# Data - $self : The object.
#
##############################################################################
sub DESTROY($)
{
my $this = $_[0];
my $self = $_[0];
my $id;
# Make sure the destructor doesn't throw any exceptions and that any
# existing exception status is preserved, otherwise constructor
# exceptions could be lost. E.g. if the constructor throws an exception
# if there is an exception, which it won't be unless the destructor is
# called.
local $@;
eval
{
local $@;
eval
{
$this->closedown();
};
$self->closedown();
};
$id = $self->{$class_name};
delete($class_objects{$id});
delete($class_records{$id});
}
#
##############################################################################
#
# Routine - CLONE
#
# Description - Class thread cloner.
#
# Data - None.
#
##############################################################################
sub CLONE()
{
# Scan through the class registry, locating the newly cloned objects and
# update the class object store accordingly.
foreach my $old_id (CORE::keys(%class_objects))
{
my($new_id,
$object);
# Look under the old id to find the newly cloned object.
$object = $class_objects{$old_id};
$new_id = refaddr($object);
# Update the entry for the class record by refiling it under the new
# unique id for the newly cloned object.
$class_records{$new_id} = $class_records{$old_id};
delete($class_records{$old_id});
# Update the id cache in the object itself and then refile our weak
# reference to the object (not counted) under its new unique id.
$object->{$class_name} = $new_id;
$class_objects{$new_id} = $object;
weaken($class_objects{$new_id});
delete($class_objects{$old_id});
}
}
#
# Description - Get a list of ancestors for the specified revisions.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain
# the revision ids.
# @revision_ids : The revision ids that are to have their
sub ancestors($$@)
{
my($this, $list, @revision_ids) = @_;
my($self, $list, @revision_ids) = @_;
return $this->mtn_command("ancestors", 0, 0, $list, @revision_ids);
return $self->mtn_command("ancestors", 0, 0, $list, @revision_ids);
}
#
# Description - Get a list of ancestors for the specified revision, that
# are not also ancestors for the specified old revisions.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to
# contain the revision ids.
# $new_revision_id : The revision id that is to have its
sub ancestry_difference($$$;@)
{
my($this, $list, $new_revision_id, @old_revision_ids) = @_;
my($self, $list, $new_revision_id, @old_revision_ids) = @_;
return $this->mtn_command("ancestry_difference",
return $self->mtn_command("ancestry_difference",
0,
0,
$list,
#
# Description - Get a list of branches.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# branch names.
# Return Value : True on success, otherwise false on failure.
sub branches($$)
{
my($this, $list) = @_;
my($self, $list) = @_;
return $this->mtn_command("branches", 0, 1, $list);
return $self->mtn_command("branches", 0, 1, $list);
}
#
#
# Description - Add the specified cert to the specified revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $revision_id : The revision id to which the cert is to be
# applied.
# $name : The name of the cert to be applied.
sub cert($$$$)
{
my($this, $revision_id, $name, $value) = @_;
my($self, $revision_id, $name, $value) = @_;
my $dummy;
return $this->mtn_command("cert",
return $self->mtn_command("cert",
1,
1,
\$dummy,
#
# Description - Get all the certs for the specified revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# $revision_id : The id of the revision that is to have its
sub certs($$$)
{
my($this, $ref, $revision_id) = @_;
my($self, $ref, $revision_id) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("certs", 0, 1, $ref, $revision_id);
return $self->mtn_command("certs", 0, 1, $ref, $revision_id);
}
else
{
my($i,
@lines);
if (! $this->mtn_command("certs", 0, 1, \@lines, $revision_id))
if (! $self->mtn_command("certs", 0, 1, \@lines, $revision_id))
{
return;
}
#
# Description - Get a list of children for the specified revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# revision ids.
# $revision_id : The revision id that is to have its children
sub children($$$)
{
my($this, $list, @revision_ids) = @_;
my($self, $list, @revision_ids) = @_;
return $this->mtn_command("children", 0, 0, $list, @revision_ids);
return $self->mtn_command("children", 0, 0, $list, @revision_ids);
}
#
# Description - Get a list of revisions that are all ancestors of the
# specified revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain
# the revision ids.
# @revision_ids : The revision ids that are to have their
sub common_ancestors($$@)
{
my($this, $list, @revision_ids) = @_;
my($self, $list, @revision_ids) = @_;
return $this->mtn_command("common_ancestors", 0, 0, $list, @revision_ids);
return $self->mtn_command("common_ancestors", 0, 0, $list, @revision_ids);
}
#
# current and base revisions are used. If no file names are
# listed then differences in all files are reported.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $options : A reference to a list containing the
sub content_diff($$;$$$@)
{
my($this, $buffer, $options, $revision_id1, $revision_id2, @file_names)
my($self, $buffer, $options, $revision_id1, $revision_id2, @file_names)
= @_;
my @opts;
push(@opts, {key => "r", value => $revision_id2})
if (defined($revision_id2));
return $this->mtn_command_with_options("content_diff",
return $self->mtn_command_with_options("content_diff",
1,
1,
$buffer,
#
# Description - Get the value of a database variable.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $domain : The domain of the database variable.
sub db_get($$$$)
{
my($this, $buffer, $domain, $name) = @_;
my($self, $buffer, $domain, $name) = @_;
return $this->mtn_command("db_get", 1, 1, $buffer, $domain, $name);
return $self->mtn_command("db_get", 1, 1, $buffer, $domain, $name);
}
#
#
# Description - Get a list of descendents for the specified revisions.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain
# the revision ids.
# @revision_ids : The revision ids that are to have their
sub descendents($$@)
{
my($this, $list, @revision_ids) = @_;
my($self, $list, @revision_ids) = @_;
return $this->mtn_command("descendents", 0, 0, $list, @revision_ids);
return $self->mtn_command("descendents", 0, 0, $list, @revision_ids);
}
#
# Description - Drop attributes from the specified file or directory,
# optionally limiting it to the specified attribute.
#
# Data - $this : The object.
# Data - $self : The object.
# $path : The name of the file or directory that is to
# have an attribute dropped.
# $key : The name of the attribute that as to be
sub drop_attribute($$$)
{
my($this, $path, $key) = @_;
my($self, $path, $key) = @_;
my $dummy;
return $this->mtn_command("drop_attribute", 1, 0, \$dummy, $path, $key);
return $self->mtn_command("drop_attribute", 1, 0, \$dummy, $path, $key);
}
#
# Description - Drop variables from the specified domain, optionally
# limiting it to the specified variable.
#
# Data - $this : The object.
# Data - $self : The object.
# $domain : The name of the domain that is to have one
# or all of its variables dropped.
# $name : The name of the variable that is to be
sub drop_db_variables($$;$)
{
my($this, $domain, $name) = @_;
my($self, $domain, $name) = @_;
my $dummy;
return $this->mtn_command("drop_db_variables",
return $self->mtn_command("drop_db_variables",
1,
0,
\$dummy,
# Description - For a given list of revisions, weed out those that are
# ancestors to other revisions specified within the list.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain
# the revision ids.
# @revision_ids : The revision ids that are to have their
sub erase_ancestors($$;@)
{
my($this, $list, @revision_ids) = @_;
my($self, $list, @revision_ids) = @_;
return $this->mtn_command("erase_ancestors", 0, 0, $list, @revision_ids);
return $self->mtn_command("erase_ancestors", 0, 0, $list, @revision_ids);
}
#
# Description - Get the result of merging two files, both of which are on
# separate revisions.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to
# contain the output from this command.
# $left_revision_id : The left hand revision id.
sub file_merge($$$$$$)
{
my($this,
my($self,
$buffer,
$left_revision_id,
$left_file_name,
$right_revision_id,
$right_file_name) = @_;
return $this->mtn_command("file_merge",
return $self->mtn_command("file_merge",
1,
1,
$buffer,
#
# Description - Generate a new key for use within the database.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or a hash that is to
# contain the output from this command.
# $key_id : The key id for the new key.
sub genkey($$$$)
{
my($this, $ref, $key_id, $pass_phrase) = @_;
my($self, $ref, $key_id, $pass_phrase) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("genkey", 1, 1, $ref, $key_id, $pass_phrase);
return $self->mtn_command("genkey", 1, 1, $ref, $key_id, $pass_phrase);
}
else
{
$kv_record,
@lines);
if (! $this->mtn_command("genkey",
if (! $self->mtn_command("genkey",
1,
1,
\@lines,
#
# Description - Get the attributes of the specified file.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# $file_name : The name of the file that is to be reported
sub get_attributes($$$)
{
my($this, $ref, $file_name) = @_;
my($self, $ref, $file_name) = @_;
my $cmd;
# This command was renamed in version 0.36 (i/f version 5.x).
if ($this->supports(MTN_GET_ATTRIBUTES))
if ($self->supports(MTN_GET_ATTRIBUTES))
{
$cmd = "get_attributes";
}
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command($cmd, 1, 1, $ref, $file_name);
return $self->mtn_command($cmd, 1, 1, $ref, $file_name);
}
else
{
my($i,
@lines);
if (! $this->mtn_command($cmd, 1, 1, \@lines, $file_name))
if (! $self->mtn_command($cmd, 1, 1, \@lines, $file_name))
{
return;
}
#
# Description - Get the revision upon which the workspace is based.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# Return Value : True on success, otherwise false on failure.
sub get_base_revision_id($$)
{
my($this, $buffer) = @_;
my($self, $buffer) = @_;
my @list;
$$buffer = "";
if (! $this->mtn_command("get_base_revision_id", 0, 0, \@list))
if (! $self->mtn_command("get_base_revision_id", 0, 0, \@list))
{
return;
}
# Description - Get a list of revisions in which the content was most
# recently changed, relative to the specified revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# revision ids.
# $revision_id : The id of the revision of the manifest that
sub get_content_changed($$$$)
{
my($this, $list, $revision_id, $file_name) = @_;
my($self, $list, $revision_id, $file_name) = @_;
my($i,
@lines);
# Run the command and get the data.
if (! $this->mtn_command("get_content_changed",
if (! $self->mtn_command("get_content_changed",
1,
0,
\@lines,
# revision, return the corresponding file name for the
# specified target revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to
# contain the output from this command.
# $source_revision_id : The source revision id.
sub get_corresponding_path($$$$$)
{
my($this, $buffer, $source_revision_id, $file_name, $target_revision_id)
my($self, $buffer, $source_revision_id, $file_name, $target_revision_id)
= @_;
my($i,
# Run the command and get the data.
if (! $this->mtn_command("get_corresponding_path",
if (! $self->mtn_command("get_corresponding_path",
1,
1,
\@lines,
# optionally limiting the output by using the specified
# options and file restrictions.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# $options : A reference to a list containing the options
sub get_current_revision($$;$@)
{
my($this, $ref, $options, @paths) = @_;
my($self, $ref, $options, @paths) = @_;
my($i,
@opts);
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command_with_options("get_current_revision",
return $self->mtn_command_with_options("get_current_revision",
1,
1,
$ref,
my @lines;
if (! $this->mtn_command_with_options("get_current_revision",
if (! $self->mtn_command_with_options("get_current_revision",
1,
1,
\@lines,
# Description - Get the revision that would be created if an unrestricted
# commit was done in the workspace.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# Return Value : True on success, otherwise false on failure.
sub get_current_revision_id($$)
{
my($this, $buffer) = @_;
my($self, $buffer) = @_;
my @list;
$$buffer = "";
if (! $this->mtn_command("get_current_revision_id", 0, 0, \@list))
if (! $self->mtn_command("get_current_revision_id", 0, 0, \@list))
{
return;
}
# Description - Get the variables stored in the database, optionally
# limiting it to the specified domain.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# $domain : The name of the domain that is to have its
sub get_db_variables($$;$)
{
my($this, $ref, $domain) = @_;
my($self, $ref, $domain) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("get_db_variables", 1, 1, $ref, $domain);
return $self->mtn_command("get_db_variables", 1, 1, $ref, $domain);
}
else
{
$name,
$value);
if (! $this->mtn_command("get_db_variables", 1, 1, \@lines, $domain))
if (! $self->mtn_command("get_db_variables", 1, 1, \@lines, $domain))
{
return;
}
# Description - Get the contents of the file referenced by the specified
# file id.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $file_id : The file id of the file that is to be
sub get_file($$$)
{
my($this, $buffer, $file_id) = @_;
my($self, $buffer, $file_id) = @_;
return $this->mtn_command("get_file", 0, 0, $buffer, $file_id);
return $self->mtn_command("get_file", 0, 0, $buffer, $file_id);
}
#
# revision. If the revision id is undefined then the current
# workspace revision is used.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $file_name : The name of the file to be fetched.
sub get_file_of($$$;$)
{
my($this, $buffer, $file_name, $revision_id) = @_;
my($self, $buffer, $file_name, $revision_id) = @_;
my @opts;
push(@opts, {key => "r", value => $revision_id})
if (defined($revision_id));
return $this->mtn_command_with_options("get_file_of",
return $self->mtn_command_with_options("get_file_of",
1,
0,
$buffer,
#
# Description - Get the manifest for the current or specified revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# $revision_id : The revision id which is to have its
sub get_manifest_of($$;$)
{
my($this, $ref, $revision_id) = @_;
my($self, $ref, $revision_id) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("get_manifest_of", 0, 1, $ref, $revision_id);
return $self->mtn_command("get_manifest_of", 0, 1, $ref, $revision_id);
}
else
{
$type,
$value);
if (! $this->mtn_command("get_manifest_of",
if (! $self->mtn_command("get_manifest_of",
0,
1,
\@lines,
# Description - Get the value of an option stored in a workspace's _MTN
# directory.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $option_name : The name of the option to be fetched.
sub get_option($$$)
{
my($this, $buffer, $option_name) = @_;
my($self, $buffer, $option_name) = @_;
if (! $this->mtn_command("get_option", 1, 1, $buffer, $option_name))
if (! $self->mtn_command("get_option", 1, 1, $buffer, $option_name))
{
return;
}
# Description - Get the revision information for the current or specified
# revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# $revision_id : The revision id which is to have its data
sub get_revision($$$)
{
my($this, $ref, $revision_id) = @_;
my($self, $ref, $revision_id) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("get_revision", 0, 1, $ref, $revision_id);
return $self->mtn_command("get_revision", 0, 1, $ref, $revision_id);
}
else
{
my @lines;
if (! $this->mtn_command("get_revision", 0, 1, \@lines, $revision_id))
if (! $self->mtn_command("get_revision", 0, 1, \@lines, $revision_id))
{
return;
}
# Description - Get the absolute path for the current workspace's root
# directory.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# Return Value : True on success, otherwise false on failure.
sub get_workspace_root($$)
{
my($this, $buffer) = @_;
my($self, $buffer) = @_;
if (! $this->mtn_command("get_workspace_root", 0, 1, $buffer))
if (! $self->mtn_command("get_workspace_root", 0, 1, $buffer))
{
return;
}
#
# Description - Get a complete ancestry graph of the database.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# Return Value : True on success, otherwise false on failure.
sub graph($$)
{
my($this, $ref) = @_;
my($self, $ref) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("graph", 0, 0, $ref);
return $self->mtn_command("graph", 0, 0, $ref);
}
else
{
@lines,
@parent_ids);
if (! $this->mtn_command("graph", 0, 0, \@lines))
if (! $self->mtn_command("graph", 0, 0, \@lines))
{
return;
}
# branch. If no branch is given then the workspace's branch
# is used.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# revision ids.
# $branch_name : The name of the branch that is to have its
sub heads($$;$)
{
my($this, $list, $branch_name) = @_;
my($self, $list, $branch_name) = @_;
return $this->mtn_command("heads", 1, 0, $list, $branch_name);
return $self->mtn_command("heads", 1, 0, $list, $branch_name);
}
#
#
# Description - Get the file id, i.e. hash, of the specified file.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $file_name : The name of the file that is to have its id
sub identify($$$)
{
my($this, $buffer, $file_name) = @_;
my($self, $buffer, $file_name) = @_;
my @list;
$$buffer = "";
if (! $this->mtn_command("identify", 1, 0, \@list, $file_name))
if (! $self->mtn_command("identify", 1, 0, \@list, $file_name))
{
return;
}
#
# Description - Get the version of the mtn automate interface.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# Return Value : True on success, otherwise false on failure.
sub interface_version($$)
{
my($this, $buffer) = @_;
my($self, $buffer) = @_;
my @list;
$$buffer = "";
if (! $this->mtn_command("interface_version", 0, 0, \@list))
if (! $self->mtn_command("interface_version", 0, 0, \@list))
{
return;
}
# limiting the output by using the specified options and file
# restrictions.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# $options : A reference to a list containing the options
sub inventory($$;$@)
{
my($this, $ref, $options, @paths) = @_;
my($self, $ref, $options, @paths) = @_;
my @opts;
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command_with_options("inventory",
return $self->mtn_command_with_options("inventory",
1,
1,
$ref,
my @lines;
if (! $this->mtn_command_with_options("inventory",
if (! $self->mtn_command_with_options("inventory",
1,
1,
\@lines,
# The output format of this command was switched over to a basic_io
# stanza in 0.37 (i/f version 6.x).
if ($this->supports(MTN_INVENTORY_IN_IO_STANZA_FORMAT))
if ($self->supports(MTN_INVENTORY_IN_IO_STANZA_FORMAT))
{
my $i;
#
# Description - Get a list of all the keys known to mtn.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that is
# to contain the output from this command.
# Return Value : True on success, otherwise false on failure.
sub keys($$)
{
my($this, $ref) = @_;
my($self, $ref) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("keys", 0, 1, $ref);
return $self->mtn_command("keys", 0, 1, $ref);
}
else
{
@lines,
@valid_fields);
if (! $this->mtn_command("keys", 0, 1, \@lines))
if (! $self->mtn_command("keys", 0, 1, \@lines))
{
return;
}
# Monotone in use.
push(@valid_fields, "given_name", "local_name")
if ($this->supports(MTN_HASHED_SIGNATURES));
if ($this->supports(MTN_COMMON_KEY_HASH))
if ($self->supports(MTN_HASHED_SIGNATURES));
if ($self->supports(MTN_COMMON_KEY_HASH))
{
push(@valid_fields, "hash");
}
#
# Description - Get a list of leaf revisions.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# revision ids.
# Return Value : True on success, otherwise false on failure.
sub leaves($$)
{
my($this, $list) = @_;
my($self, $list) = @_;
return $this->mtn_command("leaves", 0, 0, $list);
return $self->mtn_command("leaves", 0, 0, $list);
}
#
# Description - Call the specified LUA function with any required
# arguments.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $lua_function : The name of the LUA function that is to be
sub lua($$$;@)
{
my($this, $buffer, $lua_function, @arguments) = @_;
my($self, $buffer, $lua_function, @arguments) = @_;
return $this->mtn_command("lua", 1, 1, $buffer, $lua_function, @arguments);
return $self->mtn_command("lua", 1, 1, $buffer, $lua_function, @arguments);
}
#
# Description - Get the contents of the file referenced by the specified
# file id in packet format.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $file_id : The file id of the file that is to be
sub packet_for_fdata($$$)
{
my($this, $buffer, $file_id) = @_;
my($self, $buffer, $file_id) = @_;
return $this->mtn_command("packet_for_fdata", 0, 0, $buffer, $file_id);
return $self->mtn_command("packet_for_fdata", 0, 0, $buffer, $file_id);
}
#
# Description - Get the file delta between the two files referenced by the
# specified file ids in packet format.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $from_file_id : The file id of the file that is to be used
sub packet_for_fdelta($$$$)
{
my($this, $buffer, $from_file_id, $to_file_id) = @_;
my($self, $buffer, $from_file_id, $to_file_id) = @_;
return $this->mtn_command("packet_for_fdelta",
return $self->mtn_command("packet_for_fdelta",
0,
0,
$buffer,
# Description - Get the contents of the revision referenced by the
# specified revision id in packet format.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $revision_id : The revision id of the revision that is to
sub packet_for_rdata($$$)
{
my($this, $buffer, $revision_id) = @_;
my($self, $buffer, $revision_id) = @_;
return $this->mtn_command("packet_for_rdata", 0, 0, $buffer, $revision_id);
return $self->mtn_command("packet_for_rdata", 0, 0, $buffer, $revision_id);
}
#
# Description - Get all the certs for the revision referenced by the
# specified revision id in packet format.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $revision_id : The revision id of the revision that is to
sub packets_for_certs($$$)
{
my($this, $buffer, $revision_id) = @_;
my($self, $buffer, $revision_id) = @_;
return $this->mtn_command("packets_for_certs",
return $self->mtn_command("packets_for_certs",
0,
0,
$buffer,
#
# Description - Get a list of parents for the specified revision.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# revision ids.
# $revision_id : The revision id that is to have its parents
sub parents($$$)
{
my($this, $list, $revision_id) = @_;
my($self, $list, $revision_id) = @_;
return $this->mtn_command("parents", 0, 0, $list, $revision_id);
return $self->mtn_command("parents", 0, 0, $list, $revision_id);
}
#
# optionally basing it on the specified file id (this is used
# for delta encoding).
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $base_file_id : The file id of the previous version of this
sub put_file($$$$)
{
my($this, $buffer, $base_file_id, $contents) = @_;
my($self, $buffer, $base_file_id, $contents) = @_;
my @list;
if (defined($base_file_id))
{
if (! $this->mtn_command("put_file",
if (! $self->mtn_command("put_file",
0,
0,
\@list,
}
else
{
if (! $this->mtn_command("put_file", 0, 0, \@list, $contents))
if (! $self->mtn_command("put_file", 0, 0, \@list, $contents))
{
return;
}
#
# Description - Put the specified revision data into the database.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to a buffer that is to contain
# the output from this command.
# $contents : A reference to a buffer containing the
sub put_revision($$$)
{
my($this, $buffer, $contents) = @_;
my($self, $buffer, $contents) = @_;
my @list;
if (! $this->mtn_command("put_revision", 1, 0, \@list, $contents))
if (! $self->mtn_command("put_revision", 1, 0, \@list, $contents))
{
return;
}
#
# Description - Decode and store the specified packet data in the database.
#
# Data - $this : The object.
# Data - $self : The object.
# $packet_data : The packet data that is to be stored in the
# database.
# Return Value : True on success, otherwise false on failure.
sub read_packets($$)
{
my($this, $packet_data) = @_;
my($self, $packet_data) = @_;
my $dummy;
return $this->mtn_command("read_packets", 0, 0, \$dummy, $packet_data);
return $self->mtn_command("read_packets", 0, 0, \$dummy, $packet_data);
}
#
# Description - Get a list of root revisions, i.e. revisions with no
# parents.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# revision ids.
# Return Value : True on success, otherwise false on failure.
sub roots($$)
{
my($this, $list) = @_;
my($self, $list) = @_;
return $this->mtn_command("roots", 0, 0, $list);
return $self->mtn_command("roots", 0, 0, $list);
}
#
# Description - Get a list of revision ids that match the specified
# selector.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain the
# revision ids.
# $selector : The selector that is to be used.
sub select($$$)
{
my($this, $list, $selector) = @_;
my($self, $list, $selector) = @_;
return $this->mtn_command("select", 1, 0, $list, $selector);
return $self->mtn_command("select", 1, 0, $list, $selector);
}
#
#
# Description - Set an attribute on the specified file or directory.
#
# Data - $this : The object.
# Data - $self : The object.
# $path : The name of the file or directory that is to
# have an attribute set.
# $key : The name of the attribute that as to be set.
sub set_attribute($$$$)
{
my($this, $path, $key, $value) = @_;
my($self, $path, $key, $value) = @_;
my $dummy;
return $this->mtn_command("set_attribute",
return $self->mtn_command("set_attribute",
1,
0,
\$dummy,
#
# Description - Set the value of a database variable.
#
# Data - $this : The object.
# Data - $self : The object.
# $domain : The domain of the database variable.
# $name : The name of the variable to set.
# $value : The value to set the variable to.
sub set_db_variable($$$$)
{
my($this, $domain, $name, $value) = @_;
my($self, $domain, $name, $value) = @_;
my($cmd,
$dummy);
# This command was renamed in version 0.39 (i/f version 7.x).
if ($this->supports(MTN_SET_DB_VARIABLE))
if ($self->supports(MTN_SET_DB_VARIABLE))
{
$cmd = "set_db_variable";
}
{
$cmd = "db_set";
}
return $this->mtn_command($cmd, 1, 0, \$dummy, $domain, $name, $value);
return $self->mtn_command($cmd, 1, 0, \$dummy, $domain, $name, $value);
}
#
# both head revision ids and the name of the branch that they
# reside on.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array
# that is to contain the output from
# this command.
sub show_conflicts($$;$$$)
{
my($this, $ref, $branch, $left_revision_id, $right_revision_id) = @_;
my($self, $ref, $branch, $left_revision_id, $right_revision_id) = @_;
my @opts;
my $this = $class_records{$self->{$class_name}};
# Validate the number of arguments and adjust them accordingly.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command_with_options("show_conflicts",
return $self->mtn_command_with_options("show_conflicts",
1,
1,
$ref,
my($i,
@lines);
if (! $this->mtn_command_with_options("show_conflicts",
if (! $self->mtn_command_with_options("show_conflicts",
1,
1,
\@lines,
# and the specified remote server. This member function also
# provides the implementation to the pull and push methods.
#
# Data - $this : The object.
# Data - $self : The object.
# $options : A reference to a list containing the options
# to use.
# $service : The name of the server to synchronise with,
sub sync($;$$@)
{
my($this, $options, $service, @patterns) = @_;
my($self, $options, $service, @patterns) = @_;
my($cmd,
$dummy,
if (defined($service))
{
return $this->mtn_command_with_options($cmd,
return $self->mtn_command_with_options($cmd,
1,
1,
\$dummy,
}
else
{
return $this->mtn_command_with_options($cmd, 1, 1, \$dummy, \@opts);
return $self->mtn_command_with_options($cmd, 1, 1, \$dummy, \@opts);
}
}
# match the specified branch pattern. If no pattern is given
# then all branches are searched.
#
# Data - $this : The object.
# Data - $self : The object.
# $ref : A reference to a buffer or an array that
# is to contain the output from this
# command.
sub tags($$;$)
{
my($this, $ref, $branch_pattern) = @_;
my($self, $ref, $branch_pattern) = @_;
# Run the command and get the data, either as one lump or as a structured
# list.
if (ref($ref) eq "SCALAR")
{
return $this->mtn_command("tags", 1, 1, $ref, $branch_pattern);
return $self->mtn_command("tags", 1, 1, $ref, $branch_pattern);
}
else
{
my($i,
@lines);
if (! $this->mtn_command("tags", 1, 1, \@lines, $branch_pattern))
if (! $self->mtn_command("tags", 1, 1, \@lines, $branch_pattern))
{
return;
}
# Description - Sort the specified revisions such that the ancestors come
# out first.
#
# Data - $this : The object.
# Data - $self : The object.
# $list : A reference to a list that is to contain
# the revision ids.
# @revision_ids : The revision ids that are to be sorted with
sub toposort($$@)
{
my($this, $list, @revision_ids) = @_;
my($self, $list, @revision_ids) = @_;
return $this->mtn_command("toposort", 0, 0, $list, @revision_ids);
return $self->mtn_command("toposort", 0, 0, $list, @revision_ids);
}
#
#
# Description - If started then stop the mtn subprocess.
#
# Data - $this : The object.
# Data - $self : The object.
#
##############################################################################
sub closedown($)
{
my $this = $_[0];
my $self = $_[0];
my $this = $class_records{$self->{$class_name}};
if ($this->{mtn_pid} != 0)
{
# Description - Check to see if the Monotone database was locked the last
# time a command was issued.
#
# Data - $this : The object.
# Data - $self : The object.
# Return Value : True if the database was locked the last
# time a command was issues, otherwise false.
#
sub db_locked_condition_detected($)
{
my $this = $_[0];
my $self = $_[0];
my $this = $class_records{$self->{$class_name}};
return $this->{db_is_locked};
}
# Description - Return the the file name of the Monotone database as given
# to the constructor.
#
# Data - $this : The object.
# Data - $self : The object.
# Return Value : The file name of the database as given to
# the constructor or undef if no database was
# specified.
sub get_db_name($)
{
my $this = $_[0];
my $self = $_[0];
my $this = $class_records{$self->{$class_name}};
return $this->{db_name};
}
# Description - Return the message for the last error reported by this
# class.
#
# Data - $this : The object.
# Data - $self : The object.
# Return Value : The message for the last error detected, or
# an empty string if nothing has gone wrong
# yet.
sub get_error_message($)
{
my $this = $_[0];
my $self = $_[0];
my $this = $class_records{$self->{$class_name}};
return $this->{error_msg};
}
#
# Description - Return the process id of the mtn automate stdio process.
#
# Data - $this : The object.
# Data - $self : The object.
# Return Value : The process id of the mtn automate stdio
# process, or zero if no process is thought to
# be running.
sub get_pid($)
{
my $this = $_[0];
my $self = $_[0];
my $this = $class_records{$self->{$class_name}};
return $this->{mtn_pid};
}
# workspace path is actually a subdirectory within that
# workspace.
#
# Data - $this : The object.
# Data - $self : The object.
# Return Value : The workspace's base directory or undef if
# no workspace was specified and there is no
# current workspace.
sub get_ws_path($)
{
my $this = $_[0];
my $self = $_[0];
my $this = $class_records{$self->{$class_name}};
return $this->{ws_path};
}
# ignored or not. If the head revisions on a branch are all
# suspended then that branch is also ignored.
#
# Data - $this : The object.
# Data - $self : The object.
# $ignore : True if suspend certs are to be ignored
# (i.e. all revisions are `visible'),
# otherwise false if suspend certs are to be
sub ignore_suspend_certs($$)
{
my($this, $ignore) = @_;
my($self, $ignore) = @_;
my $this = $class_records{$self->{$class_name}};
# This only works from version 0.37 (i/f version 6.x).
if ($this->{honour_suspend_certs} && $ignore)
{
if ($this->supports(MTN_IGNORING_OF_SUSPEND_CERTS))
if ($self->supports(MTN_IGNORING_OF_SUSPEND_CERTS))
{
$this->{honour_suspend_certs} = undef;
$this->closedown();
$this->startup();
$self->closedown();
$self->startup();
}
else
{
elsif (! ($this->{honour_suspend_certs} || $ignore))
{
$this->{honour_suspend_certs} = 1;
$this->closedown();
$this->startup();
$self->closedown();
$self->startup();
}
return 1;
# locked handler is used as the default handler for all those
# objects that do not specify their own handlers.
#
# Data - $this : Either the object, the package name or not
# Data - $self : Either the object, the package name or not
# present depending upon how this method is
# called.
# $handler : A reference to the database locked handler
sub register_db_locked_handler(;$$$)
{
my $this;
my($self,
$this);
if ($_[0]->isa(__PACKAGE__))
{
if (ref($_[0]) ne "")
{
$this = shift();
$self = shift();
$this = $class_records{$self->{$class_name}};
}
else
{
}
my($handler, $client_data) = @_;
if (defined($this))
if (defined($self))
{
if (defined($handler))
{
# class. This is a class method rather than an object one as
# errors can be raised when calling the constructor.
#
# Data - $this : The object. This may not be present
# Data - $self : The object. This may not be present
# depending upon how this method is called and
# is ignored if it is present anyway.
# $severity : The level of error that the handler is being
# handler is used as the default handler for all those
# objects that do not specify their own handlers.
#
# Data - $this : Either the object, the package name or not
# Data - $self : Either the object, the package name or not
# present depending upon how this method is
# called.
# $handler : A reference to the I/O wait handler routine.
sub register_io_wait_handler(;$$$$)
{
my $this;
my($self,
$this);
if ($_[0]->isa(__PACKAGE__))
{
if (ref($_[0]) ne "")
{
$this = shift();
$self = shift();
$this = $class_records{$self->{$class_name}};
}
else
{
$timeout = 1;
}
if (defined($this))
if (defined($self))
{
if (defined($handler))
{
# Description - Register the specified file handle to receive data from the
# specified mtn automate stdio output stream.
#
# Data - $this : The object.
# Data - $self : The object.
# $stream : The mtn output stream from which data is to be
# read and then written to the specified file
# handle.
sub register_stream_handle($$$)
{
my($this, $stream, $handle) = @_;
my($self, $stream, $handle) = @_;
my $this = $class_records{$self->{$class_name}};
if (defined($handle)
&& ref($handle) !~ m/^IO::[^:]+/ && ref($handle) ne "GLOB")
{
# Description - Determine whether a certain feature is available with the
# version of Monotone that is currently being used.
#
# Data - $this : The object.
# Data - $self : The object.
# $feature : A constant specifying the feature that is
# to be checked for.
# Return Value : True if the feature is supported, otherwise
sub supports($$)
{
my($this, $feature) = @_;
my($self, $feature) = @_;
my $this = $class_records{$self->{$class_name}};
if ($feature == MTN_DROP_ATTRIBUTE
|| $feature == MTN_GET_ATTRIBUTES
|| $feature == MTN_SET_ATTRIBUTE)
# setting. The default setting is to perform UTF-8
# conversion.
#
# Data - $this : Either the object, the package name or not
# Data - $self : Either the object, the package name or not
# present depending upon how this method is
# called.
# $suppress : True if UTF-8 conversion is not to be done,
sub suppress_utf8_conversion($$)
{
my $this;
my($self,
$this);
if ($_[0]->isa(__PACKAGE__))
{
if (ref($_[0]) ne "")
{
$this = shift();
$self = shift();
$this = $class_records{$self->{$class_name}};
}
else
{
}
my $suppress = $_[0];
if (defined($this))
if (defined($self))
{
$this->{convert_to_utf8} = $suppress ? undef : 1;
}
# subprocess. The default action is to do so as this is
# generally safer.
#
# Data - $this : The object.
# Data - $self : The object.
# $switch : True if the mtn subprocess should be started
# in a workspace's root directory, otherwise
# false if it should be started in the current
sub switch_to_ws_root($$)
{
my $this;
my($self,
$this);
if ($_[0]->isa(__PACKAGE__))
{
if (ref($_[0]) ne "")
{
$this = shift();
$self = shift();
$this = $class_records{$self->{$class_name}};
}
else
{
}
my $switch = $_[0];
if (defined($this))
if (defined($self))
{
if (! $this->{ws_constructed})
{
if ($this->{cd_to_ws_root} && ! $switch)
{
$this->{cd_to_ws_root} = undef;
$this->closedown();
$this->startup();
$self->closedown();
$self->startup();
}
elsif (! $this->{cd_to_ws_root} && $switch)
{
$this->{cd_to_ws_root} = 1;
$this->closedown();
$this->startup();
$self->closedown();
$self->startup();
}
}
else
# data is either returned in one large lump (scalar
# reference), or an array of lines (array reference).
#
# Data - $this : The object.
# Data - $self : The object.
# $cmd : The mtn automate command that is to be run.
# $out_as_utf8 : True if any data output to mtn should be
# converted into raw UTF-8, otherwise false if
sub mtn_command($$$$$;@)
{
my($this, $cmd, $out_as_utf8, $in_as_utf8, $ref, @parameters) = @_;
my($self, $cmd, $out_as_utf8, $in_as_utf8, $ref, @parameters) = @_;
return $this->mtn_command_with_options($cmd,
return $self->mtn_command_with_options($cmd,
$out_as_utf8,
$in_as_utf8,
$ref,
# data is either returned in one large lump (scalar
# reference), or an array of lines (array reference).
#
# Data - $this : The object.
# Data - $self : The object.
# $cmd : The mtn automate command that is to be run.
# $out_as_utf8 : True if any data output to mtn should be
# converted into raw UTF-8, otherwise false if
sub mtn_command_with_options($$$$$$;@)
{
my($this, $cmd, $out_as_utf8, $in_as_utf8, $ref, $options, @parameters)
my($self, $cmd, $out_as_utf8, $in_as_utf8, $ref, $options, @parameters)
= @_;
my($buffer,
$param,
$read_ok,
$retry);
my $this = $class_records{$self->{$class_name}};
# Work out whether UTF-8 conversion is to be done at all.
# Startup the subordinate mtn process if it hasn't already been
# started.
$this->startup() if ($this->{mtn_pid} == 0);
$self->startup() if ($this->{mtn_pid} == 0);
# Send the command.
$db_locked_exception = $read_ok = $retry = undef;
eval
{
$read_ok = $this->mtn_read_output($buffer_ref);
$read_ok = $self->mtn_read_output($buffer_ref);
if ($read_ok && $in_as_utf8)
{
local $@;
# between a handled exit and one that should be dealt with.
$in = undef;
$this->closedown();
$self->closedown();
$db_locked_exception = 1;
}
|| $this->{error_msg} =~ m/$database_locked_re/)
{
$this->{db_is_locked} = 1;
$retry = &$handler($this, $handler_data);
$retry = &$handler($self, $handler_data);
}
# If we are to retry then close down the subordinate mtn process,
if ($retry)
{
$in = undef;
$this->closedown();
$self->closedown();
}
else
{
# Description - Reads the output from mtn as format 1, removing chunk
# headers.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to the buffer that is to contain
# the data.
# Return Value : True on success, otherwise false on failure.
sub mtn_read_output_format_1($$)
{
my($this, $buffer) = @_;
my($self, $buffer) = @_;
my($bytes_read,
$char,
$last,
$offset,
$size);
my $this = $class_records{$self->{$class_name}};
$err = $this->{mtn_err};
while ($this->{poll}->poll($handler_timeout) == 0)
{
&$handler($this, $handler_data);
&$handler($self, $handler_data);
}
# If necessary, read in and process the chunk header, then we know how
# Description - Reads the output from mtn as format 2, removing chunk
# headers.
#
# Data - $this : The object.
# Data - $self : The object.
# $buffer : A reference to the buffer that is to contain
# the data.
# Return Value : True on success, otherwise false on failure.
sub mtn_read_output_format_2($$)
{
my($this, $buffer) = @_;
my($self, $buffer) = @_;
my($bytes_read,
$buffer_ref,
offset => 0},
w => {buffer_ref => undef,
offset => 0});
my $this = $class_records{$self->{$class_name}};
$err = $this->{mtn_err};
while ($this->{poll}->poll($handler_timeout) == 0)
{
&$handler($this, $handler_data);
&$handler($self, $handler_data);
}
# If necessary, read in and process the chunk header, then we know how
#
# Description - If necessary start up the mtn subprocess.
#
# Data - $this : The object.
# Data - $self : The object.
#
##############################################################################
sub startup($)
{
my $this = $_[0];
my $self = $_[0];
my $this = $class_records{$self->{$class_name}};
if ($this->{mtn_pid} == 0)
{
== 0;
++ $i)
{
&$io_wait_handler($this, $io_wait_handler_data);
&$io_wait_handler($self, $io_wait_handler_data);
}
&$croaker("Cannot connect to service `"
. $this->{network_service} . "'")
# Get the interface version.
$this->interface_version(\$version);
$self->interface_version(\$version);
if ($version =~ m/^(\d+)\.(\d+)$/)
{
$this->{mtn_aif_version} = $1;
#
##############################################################################
#
# Routine - create_object_data
# Routine - create_object
#
# Description - Creates the record for the Monotone::AutomateStdio object.
# Description - Actually creates a Monotone::AutomateStdio object.
#
# Data - Return Value : A reference to an anonymous hash containing
# a complete list of initialisd fields.
# Data - $class : The name of the class that the new object
# should be blessed as.
# Return Value : A new Monotone::AutomateStdio object.
#
##############################################################################
sub create_object_data()
sub create_object($)
{
return {db_name => undef,
ws_path => undef,
network_service => undef,
ws_constructed => undef,
cd_to_ws_root => $cd_to_ws_root,
convert_to_utf8 => $convert_to_utf8,
mtn_options => undef,
mtn_pid => 0,
mtn_in => undef,
mtn_out => undef,
mtn_err => undef,
poll => undef,
error_msg => "",
honour_suspend_certs => 1,
mtn_aif_version => undef,
cmd_cnt => 0,
p_stream_handle => undef,
t_stream_handle => undef,
db_is_locked => undef,
db_locked_handler => undef,
db_locked_handler_data => undef,
io_wait_handler => undef,
io_wait_handler_data => undef,
io_wait_handler_timeout => 1};
my $class = $_[0];
my ($id,
$self,
$this);
# Create the object's data record.
$this = {db_name => undef,
ws_path => undef,
network_service => undef,
ws_constructed => undef,
cd_to_ws_root => $cd_to_ws_root,
convert_to_utf8 => $convert_to_utf8,
mtn_options => undef,
mtn_pid => 0,
mtn_in => undef,
mtn_out => undef,
mtn_err => undef,
poll => undef,
error_msg => "",
honour_suspend_certs => 1,
mtn_aif_version => undef,
cmd_cnt => 0,
p_stream_handle => undef,
t_stream_handle => undef,
db_is_locked => undef,
db_locked_handler => undef,
db_locked_handler_data => undef,
io_wait_handler => undef,
io_wait_handler_data => undef,
io_wait_handler_timeout => 1};
# Create the actual object, using it's memory address as a unique key and
# store that unique key in the object in a field named after this class for
# later reference (saves us having to keep calling refaddr()).
$self = bless({}, $class);
$id = refaddr($self);
$self->{$class_name} = $id;
# Now file the object's record in the records store, filed under the
# object's unique key. Also stash a reference to the new object in the
# objects store filed under the same key. This will be used for keeping
# track of objects when they get cloned in multi-threaded applications.
$class_records{$id} = $this;
$class_objects{$id} = $self;
# Make sure our maintenance reference to the object does not get counted so
# as to allow for normal destruction.
weaken($class_objects{$id});
return $self;
}
#
##############################################################################

Archive Download the corresponding diff file

Branches

Tags

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