← Back to branch summary

~bzr-pqm/bzr/bzr.dev

« back to all changes in this revision

Viewing changes to contrib/pwclient.full

  • Committer: Martin Pool
  • Date: 2005-09-01 06:32:52 UTC
  • Revision ID: mbp@sourcefrog.net-20050901063252-00fc761bf1076759
- make target to build emacs TAGS file

Show diffs side-by-side

added added

removed removed

Lines of Context:
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