monotone

monotone Commit Details

Date:2010-01-31 21:07:36 (9 years 3 months ago)
Author:Tony Cooper
Branch:net.venge.monotone.contrib.lib.automate-stdio
Commit:a6e1be675a2bcb18d53504eefccc90a092bdfe99
Parents: c25b5c20deadcb5847d2352bd612b31246971242
Message:Early checkin of code to get what is there working with Monontone 0.46.

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

File differences

lib/Monotone/AutomateStdio.pm
4848
4949
5050
51
5251
5352
5453
......
213212
214213
215214
215
216
217
218
216219
217220
218221
......
327330
328331
329332
330
333
334
331335
332336
333337
......
34733477
34743478
34753479
3476
3480
34773481
34783482
34793483
......
41574161
41584162
41594163
4160
4164
41614165
4162
4166
4167
41634168
41644169
41654170
......
41704175
41714176
41724177
4173
4178
41744179
41754180
41764181
......
42274232
42284233
42294234
4230
4235
42314236
42324237
42334238
......
43224327
43234328
43244329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
43254554
43264555
43274556
......
43424571
43434572
43444573
4574
43454575
4576
43464577
43474578
43484579
......
44244655
44254656
44264657
4427
4658
44284659
4429
4430
4431
4432
4433
4434
4435
4436
4437
4660
44384661
4439
4440
44414662
44424663
44434664
44444665
4445
4666
44464667
4447
4668
44484669
44494670
44504671
4672
4673
44514674
44524675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
44534710
44544711
44554712
......
46314888
46324889
46334890
4634
46354891
46364892
46374893
require 5.008005;
no locale;
use integer;
use strict;
use warnings;
"signer" => HEX_ID | STRING,
"tag" => STRING);
# Version of Monotone being used.
my $mtn_version;
# Flag for determining whether the mtn subprocess should be started in a
# workspace's root directory.
sub get_ws_details($$$);
sub mtn_command($$$$$;@);
sub mtn_command_with_options($$$$$$;@);
sub mtn_read_output($$);
sub mtn_read_output_format_1($$);
sub mtn_read_output_format_2($$);
sub parse_kv_record($$$$;$);
sub parse_revision_data($$);
sub startup($);
return 1 if ($this->{mtn_aif_major} >= 10
|| ($this->{mtn_aif_major} == 9
&& $this->{mtn_version} eq "0.43"));
&& $mtn_version == 0.43));
}
elsif ($feature == MTN_COMMON_KEY_HASH || $feature == MTN_W_SELECTOR)
#
##############################################################################
#
# Routine - mtn_read_output
# Routine - mtn_read_output_format_1
#
# Description - Reads the output from mtn, removing chunk headers.
# Description - Reads the output from mtn as format 1, removing chunk
# headers.
#
# Data - $this : The object.
# $buffer : A reference to the buffer that is to contain
sub mtn_read_output($$)
sub mtn_read_output_format_1($$)
{
my($this, $buffer) = @_;
}
# If necessary, read in and process the chunk header, then we know how
# much to read in etc.
# much to read in.
if ($chunk_start)
{
#
##############################################################################
#
# Routine - mtn_read_output_format_2
#
# Description - Reads the output from mtn as format 2, removing chunk
# headers.
#
# Data - $this : 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($bytes_read,
$buffer_ref,
$char,
$chunk_start,
$cmd_nr,
$colons,
$err,
$err_code,
$err_occurred,
$handler,
$handler_data,
$handler_timeout,
$header,
$i,
$offset_ref,
$size,
$stream);
my %buffers = (e => {buffer_ref => undef,
offset => 0},
l => {buffer_ref => undef,
offset => 0},
m => {buffer_ref => undef,
offset => 0},
p => {buffer_ref => undef,
offset => 0},
t => {buffer_ref => undef,
offset => 0},
w => {buffer_ref => undef,
offset => 0});
$err = $this->{mtn_err};
# Create the buffers.
foreach my $key (CORE::keys(%buffers))
{
if ($key eq "m")
{
$buffers{$key}->{buffer_ref} = $buffer;
}
else
{
my $ref_buf = "";
$buffers{$key}->{buffer_ref} = \$ref_buf;
}
}
# Work out what I/O wait handler is to be used.
if (defined($this->{io_wait_handler}))
{
$handler = $this->{io_wait_handler};
$handler_data = $this->{io_wait_handler_data};
$handler_timeout = $this->{io_wait_handler_timeout};
}
else
{
$handler = $io_wait_handler;
$handler_data = $io_wait_handler_data;
$handler_timeout = $io_wait_handler_timeout;
}
# Read in the data.
$$buffer = "";
$chunk_start = 1;
$buffer_ref = $buffers{m}->{buffer_ref};
$offset_ref = \$buffers{m}->{offset};
do
{
# Wait here for some data, calling the I/O wait handler every second
# whilst we wait.
while ($this->{poll}->poll($handler_timeout) == 0)
{
&$handler($this, $handler_data);
}
# If necessary, read in and process the chunk header, then we know how
# much to read in.
if ($chunk_start)
{
# Read header, one byte at a time until we have what we need or
# there is an error.
for ($header = "", $colons = $i = 0;
$colons < 3 && sysread($this->{mtn_out}, $header, 1, $i);
++ $i)
{
$char = substr($header, $i, 1);
if ($char eq ":")
{
++ $colons;
}
elsif ($colons == 1)
{
if ($char !~ m/^[elmptw]$/)
{
croak("Corrupt/missing mtn chunk header, mtn gave:\n"
. join("", <$err>));
}
}
elsif ($char =~ m/\D$/)
{
croak("Corrupt/missing mtn chunk header, mtn gave:\n"
. join("", <$err>));
}
}
# Break out the header into its separate fields.
if ($header =~ m/^(\d+):([elmptw]):(\d+):$/)
{
($cmd_nr, $stream, $size) = ($1, $2, $3);
if ($cmd_nr != $this->{cmd_cnt})
{
croak("Mtn command count is out of sequence");
}
}
else
{
croak("Corrupt/missing mtn chunk header, mtn gave:\n"
. join("", <$err>));
}
# Set up the current buffer and offset details.
$buffer_ref = $buffers{$stream}->{buffer_ref};
$offset_ref = \$buffers{$stream}->{offset};
$chunk_start = undef;
}
# Read in what we require.
if ($stream ne "l")
{
if ($size > 0)
{
if (! defined($bytes_read = sysread($this->{mtn_out},
$$buffer_ref,
$size,
$$offset_ref)))
{
croak("sysread failed: " . $!);
}
$size -= $bytes_read;
$$offset_ref += $bytes_read;
}
else
{
$chunk_start = 1;
}
}
elsif ($size == 1)
{
if (! sysread($this->{mtn_out}, $err_code, 1))
{
croak("sysread failed: " . $!);
}
$size = 0;
if ($err_code != 0)
{
$err_occurred = 1;
}
}
else
{
croak("Invalid message state");
}
}
while ($size > 0 || $stream ne "l");
++ $this->{cmd_cnt};
# Record any error or warning messages.
if (${$buffers{e}->{buffer_ref}} ne "")
{
$this->{error_msg} = ${$buffers{e}->{buffer_ref}};
}
elsif (${$buffers{w}->{buffer_ref}} ne "")
{
$this->{error_msg} = ${$buffers{w}->{buffer_ref}};
}
# If something has gone wrong then deal with it.
if ($err_occurred)
{
$$buffer = "";
return;
}
return 1;
}
#
##############################################################################
#
# Routine - startup
#
# Description - If necessary start up the mtn subprocess.
my(@args,
$cwd,
$file,
$exception,
$line,
$my_pid,
$version);
$this->{poll} = IO::Poll->new();
$this->{poll}->mask($this->{mtn_out}, POLLIN | POLLPRI | POLLHUP);
# Get the interface version.
# If necessary get the version of the actual application.
$this->interface_version(\$version);
($this->{mtn_aif_major}, $this->{mtn_aif_minor}) =
($version =~ m/^(\d+)\.(\d+)$/);
# If necessary get the version of the actual application (sometimes
# needed to differentiate when certain features were introduced that do
# not affect the automate stdio interface version).
if ($this->{mtn_aif_major} == 9)
if (! defined($mtn_version))
{
my($file,
$line);
&$croaker("Could not run command `mtn --version'")
unless (defined($file = IO::File->new("mtn --version |")));
while (defined($line = $file->getline()))
{
if ($line =~ m/^monotone (\d+\.\d*) ./)
if ($line =~ m/^monotone (\d+\.\d+) ./)
{
$this->{mtn_version} = $1;
$mtn_version = $1;
}
}
$file->close();
&$croaker("Could not determine the version of Monotone")
unless (defined($mtn_version));
}
# If the version is higher than 0.45 then we need to skip the header
# which is terminated by two blank lines.
if ($mtn_version > 0.45)
{
my($char,
$last_char);
$char = "";
do
{
$last_char = $char;
&$croaker("Cannot get format header")
unless (sysread($this->{mtn_out}, $char, 1));
}
while ($char ne "\n" || $last_char ne "\n")
}
# Set up the correct input handler depending upon the version of mtn.
if ($mtn_version > 0.45)
{
*mtn_read_output = *mtn_read_output_format_2;
}
else
{
*mtn_read_output = *mtn_read_output_format_1;
}
# Get the interface version.
$this->interface_version(\$version);
($this->{mtn_aif_major}, $this->{mtn_aif_minor}) =
($version =~ m/^(\d+)\.(\d+)$/);
}
}
honour_suspend_certs => 1,
mtn_aif_major => 0,
mtn_aif_minor => 0,
mtn_version => undef,
cmd_cnt => 0,
db_is_locked => undef,
db_locked_handler => undef,

Archive Download the corresponding diff file

Branches

Tags

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