« back to all changes in this revision
Viewing changes to contrib/pwclient.full
- browse files at revision 715
- compare with another revision
- compare with revision 1418
- download diff
- download tarball
- view history from revision 715
- Committer: Martin Pool
- Date: 2005-06-20 04:24:35 UTC
- Revision ID: mbp@sourcefrog.net-20050620042435-7c315b5a93001b89
- add jk's patchwork client
- files added:
- contrib/pwclient.full
added
removed
contrib/pwclient.full
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
20
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
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
259
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
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
342
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
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
426
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
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
556
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
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
616
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
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
Loggerhead is a web-based interface for Breezy
Version: 2.0.1