~bzr-pqm/bzr/bzr.dev

1185.1.29 by Robert Collins
merge merge tweaks from aaron, which includes latest .dev
1
#!/usr/bin/perl -w
2
#
3
# Patchwork - automated patch tracking system
4
# Copyright (C) 2005 Jeremy Kerr <jk@ozlabs.org>
5
#
6
# This file is part of the Patchwork package.
7
#
8
# Patchwork is free software; you can redistribute it and/or modify
9
# it under the terms of the GNU General Public License as published by
10
# the Free Software Foundation; either version 2 of the License, or
11
# (at your option) any later version.
12
#
13
# Patchwork is distributed in the hope that it will be useful,
14
# but WITHOUT ANY WARRANTY; without even the implied warranty of
15
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
# GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License
19
# along with Patchwork; if not, write to the Free Software
4183.7.1 by Sabin Iacob
update FSF mailing address
20
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
1185.1.29 by Robert Collins
merge merge tweaks from aaron, which includes latest .dev
21
22
use strict;
23
use lib '../lib';
24
25
use SOAP::Lite;
26
use Getopt::Std;
27
28
my $uri = 'urn:SOAPInterface';
29
# this URI has the address of the soap.pl script, followed by the project name
30
my $proxy = 'http://patchwork.ozlabs.org/soap.pl/bazaar-ng';
31
my $soap;
32
my ($rows, $cols);
33
34
my %actions = (
35
	list   => 'List all patches (restrict to a state with -s <state>)',
36
	view   => 'View a patch',
37
	get    => 'Download a patch and save it locally',
38
	apply  => 'Apply a patch (in the current dir, using -p1)',
39
	search => 'Search for patches (by name)'
40
);
41
42
sub page($@)
43
{
44
	my $str = shift;
45
	my $lines;
46
	if (@_) {
47
		($lines) = @_;
48
	} else {
49
		my @l = split(/\n/, $str);
50
		$lines = $#l;
51
	}
52
	if ($rows && $lines >= $rows) {
53
		my $pager = $ENV{PAGER} || 'more';
54
		open(FH, "|-", $pager) || die "Couldn't run pager '$pager': $!";
55
		print FH $str;
56
		close(FH);
57
	} else {
58
		print $str;
59
	}
60
}
61
62
sub patch_list(@)
63
{
64
	my @patches = @_;
65
	my $states = 
66
	return "No patches\n" unless @patches;
67
	my $str = list_header();
68
	my $max = $cols - 9;
69
	$max = 10 if $max < 10;
70
	foreach my $patch (@patches) {
71
		my $name = $patch->name();
72
		if ($cols && length($name) > $max) {
73
			$name = substr($name, 0, $max - 1).'$';
74
		}
75
		$str .= sprintf "%4d %3s %s\n", $patch->id(),
76
				substr(states($patch->state()), 0, 3),
77
				$name;
78
	}
79
	return $str;
80
}
81
82
sub _get_patch($)
83
{
84
	my ($id) = @_;
85
	unless ($id) {
86
		print STDERR "No id given to retrieve a patch\n";
87
		exit 1;
88
	}
89
90
	unless ($id =~ m/^[0-9]+$/) {
91
		print STDERR "Invalid patch id '$id'\n'";
92
		exit 1;
93
	}
94
95
	my $res = $soap->get_patch($id);
96
	die "SOAP fault: ".$res->faultstring if $res->fault;
97
	my $patch = $res->result;
98
	unless ($patch) {
99
		print STDERR "Patch not found\n";
100
		exit 1;
101
	}
102
	return $patch;
103
}
104
105
sub list()
106
{
107
	my %opts;
108
	my $res;
109
	getopts('s:', \%opts);
110
	if ($opts{s}) {
111
		$res = $soap->get_patches_by_state(state_from_name($opts{s}));
112
	} else {
113
		$res = $soap->get_patches();
114
	}
115
	die "SOAP fault: ".$res->faultstring if $res->fault;
116
	my $patches = $res->result;
117
	page(patch_list(@$patches), $#{$patches} + 2);
118
	return 1;
119
}
120
121
sub search()
122
{
123
	my $query = join(' ', map { '"'.$_.'"' } @ARGV);
124
	my $res = $soap->search($query);
125
	die "SOAP fault: ".$res->faultstring if $res->fault;
126
	my $patches = $res->result;
127
	my $str = '';
128
	unless ($patches && @{$patches}) {
129
		print "No patches found\n";
130
		return 1;
131
	}
132
	
133
	$str .= list_header();
134
	page(patch_list(@$patches), $#{$patches});
135
	return 1;
136
}
137
138
sub view()
139
{
140
	my ($id) = @ARGV;
141
	my $patch = _get_patch($id);
142
	page($patch->content());
143
	return 1;
144
}
145
146
sub get()
147
{
148
	my ($id) = @ARGV;
149
	my $patch = _get_patch($id);
150
	if (-e $patch->filename()) {
151
		printf STDERR "Patch file:\n\t%s\nalready exists\n",
152
			$patch->filename();
153
		exit 1;
154
	}
155
	open(FH, ">", $patch->filename())
156
		or die "Couldn't open ".$patch->filename()." for writing: $!";
157
	print FH $patch->content;
158
	close(FH);
159
	printf "Saved '%s'\n\tto: %s\n", $patch->name, $patch->filename();
160
	return 1;
161
}
162
163
sub apply()
164
{
165
	my ($id) = @ARGV;
166
	my $patch = _get_patch($id);
167
	open(FH, "|-", "patch", "-p1")
168
		or die "Couldn't execute 'patch -p1'";
169
	print FH $patch->content;
170
	close(FH);
171
	return 1;
172
}
173
174
sub usage()
175
{
176
	printf STDERR "Usage: %s <action> [options]\n", $0;
177
	printf STDERR "Where <action> is one of:\n";
178
	printf STDERR "\t%-6s : %s\n", $_, $actions{$_} for sort keys %actions;
179
}
180
181
sub list_header()
182
{
183
	return sprintf "%4s %3s %s\n", 'ID', 'Sta', 'Name';
184
}
185
186
my %_states;
187
sub states(@)
188
{
189
	my $state = @_ ? shift : undef;
190
	unless (%_states) {
191
		my $res = $soap->get_states();
192
		die "SOAP fault: ".$res->faultstring if $res->fault;
193
		my $stateref = $res->result;
194
		%_states = %$stateref;
195
	}
196
	return $state ? $_states{$state} : %_states;
197
}
198
199
sub state_from_name($)
200
{
201
	my ($name) = @_;
202
	my @matches;
203
	my %states = states();
204
	foreach my $id (keys(%states)) {
205
		push(@matches, $id) if ($states{$id} =~ m/^$name/i);
206
	}
207
	if ($#matches < 0) {
208
		print STDERR "No such state '$name'\n";
209
		exit 1;
210
	} elsif ($#matches > 0) {
211
		printf STDERR "Multiple states match '$name':\n";
212
		printf STDERR "\t%s\n", $states{$_} for @matches;
213
		exit 1;
214
	}
215
	return $matches[0];
216
}
217
218
my $action = shift;
219
unless ($action) {
220
	usage();
221
	exit 1;
222
}
223
224
if (eval "require Term::Size") {
225
	($cols, $rows) = Term::Size::chars(*STDOUT);
226
} else {
227
	($cols, $rows) = (0,0);
228
}
229
230
$soap = new SOAP::Lite(uri => $uri, proxy => $proxy);
231
232
foreach (sort(keys(%actions))) {
233
	if ($_ eq $action) {
234
		eval "return &$action()" or die $@;
235
		exit 0;
236
	}
237
}
238
printf STDERR "No such action '%s'\n", $action;
239
usage();
240
exit 1;
241
242
# Patchwork - automated patch tracking system
243
# Copyright (C) 2005 Jeremy Kerr <jk@ozlabs.org>
244
#
245
# This file is part of the Patchwork package.
246
#
247
# Patchwork is free software; you can redistribute it and/or modify
248
# it under the terms of the GNU General Public License as published by
249
# the Free Software Foundation; either version 2 of the License, or
250
# (at your option) any later version.
251
#
252
# Patchwork is distributed in the hope that it will be useful,
253
# but WITHOUT ANY WARRANTY; without even the implied warranty of
254
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
255
# GNU General Public License for more details.
256
#
257
# You should have received a copy of the GNU General Public License
258
# along with Patchwork; if not, write to the Free Software
4183.7.1 by Sabin Iacob
update FSF mailing address
259
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
1185.1.29 by Robert Collins
merge merge tweaks from aaron, which includes latest .dev
260
261
package PatchWork::Comment;
262
263
use strict;
264
265
# internal variables
266
#  id
267
#  msgid
268
#  submitter
269
#  content
270
#  date
271
#  @refs
272
273
sub new($)
274
{
275
	my ($cls) = @_;
276
	my $obj = {};
277
	bless($obj, $cls);
278
	return $obj;
279
}
280
281
sub id(@)
282
{
283
	my ($obj) = shift;
284
	if (@_) { $obj->{id} = shift }
285
	return $obj->{id};
286
}
287
288
sub submitter(@)
289
{
290
	my ($obj) = shift;
291
	if (@_) { $obj->{submitter} = shift }
292
	return $obj->{submitter};
293
}
294
295
sub msgid(@)
296
{
297
	my ($obj) = shift;
298
	if (@_) { $obj->{msgid} = shift }
299
	return $obj->{msgid};
300
}
301
302
sub date(@)
303
{
304
	my ($obj) = shift;
305
	if (@_) { $obj->{date} = shift }
306
	return $obj->{date};
307
}
308
309
sub content(@)
310
{
311
	my ($obj) = shift;
312
	if (@_) { $obj->{content} = shift }
313
	return $obj->{content};
314
}
315
316
sub refs(@)
317
{
318
	my ($obj) = shift;
319
	push(@{$obj->{refs}}, @_) if @_;
320
	return $obj->{refs};
321
}
322
323
1;
324
325
# Patchwork - automated patch tracking system
326
# Copyright (C) 2005 Jeremy Kerr <jk@ozlabs.org>
327
#
328
# This file is part of the Patchwork package.
329
#
330
# Patchwork is free software; you can redistribute it and/or modify
331
# it under the terms of the GNU General Public License as published by
332
# the Free Software Foundation; either version 2 of the License, or
333
# (at your option) any later version.
334
#
335
# Patchwork is distributed in the hope that it will be useful,
336
# but WITHOUT ANY WARRANTY; without even the implied warranty of
337
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
338
# GNU General Public License for more details.
339
#
340
# You should have received a copy of the GNU General Public License
341
# along with Patchwork; if not, write to the Free Software
4183.7.1 by Sabin Iacob
update FSF mailing address
342
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
1185.1.29 by Robert Collins
merge merge tweaks from aaron, which includes latest .dev
343
344
package PatchWork::Person;
345
346
use strict;
347
348
# internal variables
349
#   email
350
#   name
351
352
sub new(@)
353
{
354
	my $cls = shift;
355
	my $obj = {};
356
	bless($obj, $cls);
357
	$obj->{email} = shift;
358
	$obj->{name} = shift;
359
	return $obj;
360
}
361
362
sub parse_from($$)
363
{
364
	my ($obj, $str) = @_;
365
366
	if ($str =~ m/"?(.*?)"?\s*<([^>]+)>/) {
367
		$obj->{email} = $2;
368
		$obj->{name} = $1;
369
	
370
	} elsif ($str =~ m/"?(.*?)"?\s*\(([^\)]+)\)/) {
371
		$obj->{email} = $1;
372
		$obj->{name} = $2;
373
	
374
	} else {
375
		$obj->{email} = $str;
376
	}
377
}
378
379
sub id(@)
380
{
381
	my ($obj) = shift;
382
	if (@_) { $obj->{id} = shift }
383
	return $obj->{id};
384
}
385
386
sub email(@)
387
{
388
	my ($obj) = shift;
389
	if (@_) { $obj->{email} = shift }
390
	return $obj->{email};
391
}
392
393
sub name(@)
394
{
395
	my ($obj) = shift;
396
	if (@_) { $obj->{name} = shift }
397
	return $obj->{name};
398
}
399
400
sub username(@)
401
{
402
	my ($obj) = shift;
403
	if (@_) { $obj->{username} = shift }
404
	return $obj->{username};
405
}
406
407
1;
408
409
# Patchwork - automated patch tracking system
410
# Copyright (C) 2005 Jeremy Kerr <jk@ozlabs.org>
411
#
412
# This file is part of the Patchwork package.
413
#
414
# Patchwork is free software; you can redistribute it and/or modify
415
# it under the terms of the GNU General Public License as published by
416
# the Free Software Foundation; either version 2 of the License, or
417
# (at your option) any later version.
418
#
419
# Patchwork is distributed in the hope that it will be useful,
420
# but WITHOUT ANY WARRANTY; without even the implied warranty of
421
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
422
# GNU General Public License for more details.
423
#
424
# You should have received a copy of the GNU General Public License
425
# along with Patchwork; if not, write to the Free Software
4183.7.1 by Sabin Iacob
update FSF mailing address
426
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
1185.1.29 by Robert Collins
merge merge tweaks from aaron, which includes latest .dev
427
428
package PatchWork::Patch;
429
430
use strict;
431
432
# internal variables
433
#  id
434
#  msgid
435
#  date
436
#  name
437
#  content
438
#  filename
439
#  submitter
440
#  comments
441
#  @trees
442
443
sub new($)
444
{
445
	my ($cls) = @_;
446
	my $obj = {};
447
	bless($obj, $cls);
448
	$obj->{comments} = [];
449
	$obj->{trees} = {};
450
	$obj->{archived} = 0;
451
	$obj->{state} = 1;
452
	return $obj;
453
}
454
455
sub id(@)
456
{
457
	my ($obj) = shift;
458
	if (@_) { $obj->{id} = shift }
459
	return $obj->{id};
460
}
461
462
sub msgid(@)
463
{
464
	my ($obj) = shift;
465
	if (@_) { $obj->{msgid} = shift }
466
	return $obj->{msgid};
467
}
468
469
sub date(@)
470
{
471
	my ($obj) = shift;
472
	if (@_) { $obj->{date} = shift }
473
	return $obj->{date};
474
}
475
476
sub state(@)
477
{
478
	my ($obj) = shift;
479
	if (@_) { $obj->{state} = shift }
480
	return $obj->{state};
481
}
482
483
sub name(@)
484
{
485
	my ($obj) = shift;
486
	if (@_) { $obj->{name} = shift }
487
	return $obj->{name};
488
}
489
490
sub filename(@)
491
{
492
	my ($obj) = shift;
493
	if (@_) { $obj->{filename} = shift }
494
	return $obj->{filename};
495
}
496
497
sub submitter(@)
498
{
499
	my ($obj) = shift;
500
	if (@_) { $obj->{submitter} = shift }
501
	return $obj->{submitter};
502
}
503
504
sub content(@)
505
{
506
	my ($obj) = shift;
507
	if (@_) { $obj->{content} = shift }
508
	return $obj->{content};
509
}
510
511
sub archived(@)
512
{
513
	my ($obj) = shift;
514
	if (@_) { $obj->{archived} = shift }
515
	return $obj->{archived};
516
}
517
518
sub add_comment($$)
519
{
520
	my ($obj, $comment) = @_;
521
	push(@{$obj->{comments}}, $comment);
522
}
523
524
sub comments($)
525
{
526
	my ($obj) = @_;
527
	return $obj->{comments};
528
}
529
530
sub trees(@)
531
{
532
	my ($obj) = shift;
533
	if (@_) { $obj->{trees} = shift }
534
	return $obj->{trees};
535
}
536
537
1;
538
539
# Patchwork - automated patch tracking system
540
# Copyright (C) 2005 Jeremy Kerr <jk@ozlabs.org>
541
#
542
# This file is part of the Patchwork package.
543
#
544
# Patchwork is free software; you can redistribute it and/or modify
545
# it under the terms of the GNU General Public License as published by
546
# the Free Software Foundation; either version 2 of the License, or
547
# (at your option) any later version.
548
#
549
# Patchwork is distributed in the hope that it will be useful,
550
# but WITHOUT ANY WARRANTY; without even the implied warranty of
551
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
552
# GNU General Public License for more details.
553
#
554
# You should have received a copy of the GNU General Public License
555
# along with Patchwork; if not, write to the Free Software
4183.7.1 by Sabin Iacob
update FSF mailing address
556
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
1185.1.29 by Robert Collins
merge merge tweaks from aaron, which includes latest .dev
557
558
package PatchWork::Tree;
559
560
use strict;
561
562
# internal variables
563
#   id
564
#   name
565
#   url
566
567
sub new($$)
568
{
569
	my ($cls, $id) = @_;
570
	my $obj = {};
571
	bless($obj, $cls);
572
	$obj->{id} = $id;
573
	return $obj;
574
}
575
576
sub id($)
577
{
578
	my ($obj) = @_;
579
	return $obj->{id};
580
581
}
582
583
sub name(@)
584
{
585
	my ($obj) = shift;
586
	if (@_) { $obj->{name} = shift }
587
	return $obj->{name};
588
}
589
590
sub url(@)
591
{
592
	my ($obj) = shift;
593
	if (@_) { $obj->{url} = shift }
594
	return $obj->{url};
595
}
596
597
1;
598
599
# Patchwork - automated patch tracking system
600
# Copyright (C) 2005 Jeremy Kerr <jk@ozlabs.org>
601
#
602
# This file is part of the Patchwork package.
603
#
604
# Patchwork is free software; you can redistribute it and/or modify
605
# it under the terms of the GNU General Public License as published by
606
# the Free Software Foundation; either version 2 of the License, or
607
# (at your option) any later version.
608
#
609
# Patchwork is distributed in the hope that it will be useful,
610
# but WITHOUT ANY WARRANTY; without even the implied warranty of
611
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
612
# GNU General Public License for more details.
613
#
614
# You should have received a copy of the GNU General Public License
615
# along with Patchwork; if not, write to the Free Software
4183.7.1 by Sabin Iacob
update FSF mailing address
616
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
1185.1.29 by Robert Collins
merge merge tweaks from aaron, which includes latest .dev
617
618
package PatchWork::User;
619
@PatchWork::User::ISA = ('PatchWork::Person');
620
621
use strict;
622
623
# internal variables
624
#   username
625
626
sub new($$)
627
{
628
	my ($cls, $id) = @_;
629
	my $obj = {};
630
	bless($obj, $cls);
631
	$obj->{id} = $id;
632
	return $obj;
633
}
634
635
sub username(@)
636
{
637
	my ($obj) = shift;
638
	if (@_) { $obj->{username} = shift }
639
	return $obj->{username};
640
}
641
642
1;
643