source: server/trunk/web/lib/Sophie/Controller/Chat/Cmd.pm @ 291

Last change on this file since 291 was 291, checked in by nanardon, 13 years ago
  • add list command to bot
  • Property svn:keywords set to Id Rev
File size: 21.9 KB
Line 
1package Sophie::Controller::Chat::Cmd;
2use Moose;
3use namespace::autoclean;
4use Getopt::Long;
5
6BEGIN {extends 'Catalyst::Controller'; }
7
8=head1 NAME
9
10Sophie::Controller::Chat::Cmd - Catalyst Controller
11
12=head1 DESCRIPTION
13
14Catalyst Controller.
15
16=head1 METHODS
17
18=cut
19
20
21=head2 index
22
23=cut
24
25=head2 end
26
27=cut
28
29sub end : Private {
30    my ($self, $c ) = @_;
31   
32    $c->forward('/chat/update_statistic', [ ($c->action =~ /([^\/]+)$/)[0] ]);
33
34    my $reqspec = $c->req->arguments->[0];
35    $reqspec->{max_line} ||= 4;
36    my $message =  $c->stash->{xmlrpc};
37
38    my @backup = @{ $message->{message} };
39    my $needpaste = 0;
40
41    if (@{ $message->{message} } > ($reqspec->{max_line})) {
42        @{ $message->{message} } = 
43            # -2 because line 0 and we remove one for paste url
44            @backup[0 .. $reqspec->{max_line} -2];
45        $needpaste = 1;
46    } 
47
48    if ($needpaste && !$reqspec->{nopaste}) {
49        my $cmd = ($c->action =~ /([^\/]+)$/)[0];
50        my (undef, undef, @args) = @{ $c->req->arguments };
51        my $title = join(' ', $cmd, @args); 
52        my $id = $c->forward('/chat/paste', [ $title, join("\n", @backup) ]);
53        if ($id) {
54            push(@{ $message->{message} }, 'All results available here: ' . $c->uri_for('/chat', $id));
55        }
56    }
57
58    $c->stash->{xmlrpc} = $message;
59
60    $c->forward('/end');
61}
62
63=head1 BOT COMMAND
64
65=head2 REPLY
66
67=cut
68
69sub _commands {
70    my ( $self, $c ) = @_;
71    [ grep { m/^[^_]/ } map { $_->name } $self->get_action_methods() ];
72}
73
74sub _getopt : Private {
75    my ( $self, $c, $options, @args) = @_;
76
77    local @ARGV = @args;
78
79    GetOptions(%{ $options || {} });
80
81    return \@ARGV;
82}
83
84sub _fmt_location : Private {
85    my ($self, $c, $searchspec, $pkgid) = @_;
86
87    my @loc;
88    foreach (@{ $c->forward('/rpms/location', [ $pkgid ]) }) {
89        push @loc, sprintf(
90            '%s (%s, %s, %s)',
91            $_->{media},
92            $_->{dist} || $_->{distribution},
93            $_->{release},
94            $_->{arch},
95        );
96    }
97    return join(', ', @loc);
98}
99
100sub _find_rpm_elsewhere : Private {
101    my ($self, $c, $searchspec, $name) = @_;
102    if ($searchspec->{distribution}) {
103        my $rpmlist = $c->forward('/search/rpm/byname', [ 
104                {
105                    distribution => $searchspec->{distribution},
106                    src => $searchspec->{src},
107                    rows => 1,
108                }, $name ]);
109        if (@{$rpmlist}) {
110            return $c->forward('_fmt_location', [ { 
111                        distribution => $searchspec->{distribution}
112                    }, $rpmlist->[0] ]);
113        }
114    }
115    my $rpmlist = $c->forward('/search/rpm/byname', [ { src =>
116                $searchspec->{src}}, $name ]);
117    my %dist;
118    foreach(@$rpmlist) {
119        foreach (@{ $c->forward('/rpms/location', [ $_ ]) }) {
120            $dist{$_->{dist} || $_->{distribution}} = 1;
121        }
122    }
123    if (keys %dist) {
124        return join(', ', sort keys %dist);
125    }
126    return;
127}
128
129=head1 AVAILABLE FUNCTIONS
130
131=cut
132
133=head2 help [cmd]
134
135Return help about command cmd or list available command.
136
137=cut
138
139sub help : XMLRPC {
140    my ( $self, $c, $reqspec, $cmd ) = @_;
141    if ($cmd) {
142        my @message = grep { /\S+/ } split(/\n/,
143            $c->model('Help::POD')->bot_help_text($cmd) || 'No help available');
144        return $c->{stash}->{xmlrpc} = {
145            private_reply => 1,
146            message => \@message,
147        };
148    } else {
149        return $c->{stash}->{xmlrpc} = {
150            private_reply => 1,
151            message => [
152                'available command:',
153                join(', ', sort grep { $_ !~ /^end$/ } @{ $self->_commands }),
154                'Find more at ' . $c->uri_for('/help/chat'),
155            ],
156        }
157    }
158}
159
160=head2 asv
161
162ASV means in french "age, sexe, ville" (age, sex and town).
163Return the version of the Chat module version.
164
165=cut
166
167sub asv : XMLRPC {
168    my ( $self, $c ) = @_;
169    return $c->stash->{xmlrpc} = {
170        message => [ 'Sophie: ' . $Sophie::VERSION . ', Chat ' . q$Rev$ ],
171    };
172}
173
174=head2 list [distribution [release [arch]]]
175
176List available distribution, release, architecture matching given arguments.
177
178=cut
179
180sub list : XMLRPC {
181    my ($self, $c, $reqspec, @args) = @_;
182
183    my $distrib = {
184        distribution => $args[0],
185        release      => $args[1],
186        arch         => $args[2],
187    };
188
189    if (!$c->forward('/distrib/exists', [ $distrib ])) {
190        return $c->stash->{xmlrpc} = {
191            message => [ "I don't have any distribution matching: "
192                         . join(' / ', grep { $_ } @args[0..2]) ],
193        };
194    }
195
196    my @list = @{ $c->forward('/distrib/list', [ $distrib ]) };
197    return $c->stash->{xmlrpc} = {
198        message => [ 
199            ($args[0] 
200                ? join(' / ', grep { $_ } @args[0..2]) . ': '
201                : '') .
202            join(', ', @list) ],
203    }
204}
205
206=head2 q REGEXP
207
208Search rpm name matching C<REGEXP>.
209
210NB: C<.>, C<*>, C<+> have special meaning
211and have to be escaped.
212
213=cut
214
215sub q : XMLRPC {
216    my ($self, $c, $reqspec, @args) = @_;
217
218    $reqspec->{src} = 0;
219
220    @args = @{ $c->forward('_getopt', [
221        {
222            'd=s' => \$reqspec->{distribution},
223            'v=s' => \$reqspec->{release},
224            'a=s' => \$reqspec->{arch},
225            's'   => sub { $reqspec->{src} = 1 },
226        }, @args ]) };
227
228    my $res = $c->forward('/search/tags/name_regexp', $reqspec, $args[0]);
229    warn join(' ', @{ $res });
230    if (!@{ $res }) {
231        return $c->stash->{xmlrpc} = {
232            message => [ 'Nothing match `' . $args[0] . '\'' ]
233        };
234    } else {
235        my @message = 'rpm name matching `' . $args[0] . '\':';
236        while (@{ $res }) {
237            my $str = '';
238            while (length($str) < 70) {
239                my $item = shift(@{ $res }) or last;
240                $str .= ', ' if ($str);
241                $str .= $item->{name};
242            }
243            push(@message, $str);
244        }
245        return $c->stash->{xmlrpc} = {
246            message => \@message,
247        };
248    }
249}
250
251=head2 whatis WORD [WORD2 [...]]
252
253Search rpm having description containing words given as arguments
254
255=cut
256
257sub whatis : XMLRPC {
258    my ($self, $c, $reqspec, @args) = @_;
259
260    $reqspec->{src} = 0;
261
262    @args = @{ $c->forward('_getopt', [
263        {
264            'd=s' => \$reqspec->{distribution},
265            'v=s' => \$reqspec->{release},
266            'a=s' => \$reqspec->{arch},
267            's'   => sub { $reqspec->{src} = 1 },
268        }, @args ]) };
269    my $res = $c->forward('/search/rpm/description', [ $reqspec, @args ]);
270
271    if (@{ $res }) {
272        if (@{ $res } > 100) {
273            return $c->stash->{xmlrpc} = {
274                message => [ 'I have ' . @{ $res } . ' results' ],
275            };
276        } else {
277            my @names = ();
278            foreach (@{ $res }) {
279                my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
280                push(@names, $info->{name});
281            }
282            my @message = 'rpm name matching `' . $args[0] . '\':';
283            while (@names) {
284                my $str = '';
285                while (length($str) < 70) {
286                    my $item = shift(@names) or last;
287                    $str .= ', ' if ($str);
288                    $str .= $item;
289                }
290                push(@message, $str);
291            }
292            return $c->stash->{xmlrpc} = {
293                message => \@message,
294            };
295        }
296    } else {
297        return $c->stash->{xmlrpc} = {
298            message => [ 'No rpm description matches this keywords' ],
299        };
300    }
301}
302
303=head2 version [-s] NAME
304
305Show the version of package C<NAME>.
306
307=cut
308
309sub version : XMLRPC {
310    my ($self, $c, $reqspec, @args) = @_;
311
312    my @message;
313    $reqspec->{src} = 0;
314
315    @args = @{ $c->forward('_getopt', [
316        {
317            'd=s' => \$reqspec->{distribution},
318            'v=s' => \$reqspec->{release},
319            'a=s' => \$reqspec->{arch},
320            's'   => sub { $reqspec->{src} = 1 },
321        }, @args ]) };
322
323    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
324        return $c->stash->{xmlrpc} = {
325            message => [ "I don't have such distribution" ]
326        };
327    }
328
329    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
330    if (!@{ $rpmlist }) {
331        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
332        if ($else) {
333            return $c->stash->{xmlrpc} = {
334                message => [ 
335                    "There is no rpm named `$args[0]', but the word matches in " . $else
336                ],
337            }
338        } else {
339            return $c->stash->{xmlrpc} = {
340                message => [ "The rpm named `$args[0]' has not been found" ],
341            }
342        }
343    }
344    foreach (@{ $rpmlist }) {
345        my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
346        push @message, $info->{evr} . ' // ' .
347            $c->forward('_fmt_location', [ $reqspec, $_ ]);
348    }
349    return $c->stash->{xmlrpc} = {
350        message => \@message,
351    }
352}
353
354=head2 v
355
356C<v> is an alias for L<version> command.
357
358=cut
359
360sub v : XMLRPC {
361    my ($self, $c, @args) = @_;
362    $c->forward('version', [ @args ]);
363}
364
365=head2 summary [-s] NAME
366
367Show the summary of package C<NAME>.
368
369=cut
370
371sub summary : XMLRPC {
372    my ($self, $c, $reqspec, @args) = @_;
373
374    $c->forward('qf', [ $reqspec, @args, '%{summary}' ]);
375}
376
377=head2 s
378
379Is an alias for C<summary> command.
380
381=cut
382
383sub s : XMLRPC {
384    my ($self, $c, @args) = @_;
385    $c->forward('summary', [ @args ]);
386}
387
388=head2 packager [-s] NAME
389
390Show the packager of package C<NAME>.
391
392=cut
393
394sub packager : XMLRPC {
395    my ($self, $c, $reqspec, @args) = @_;
396
397    $c->forward('qf', [ $reqspec, @args, '%{packager}' ]);
398}
399
400=head2 p
401
402Is an alias for C<packager> command.
403
404=cut
405
406sub p : XMLRPC {
407    my ($self, $c, @args) = @_;
408    $c->forward('packager', [ @args ]);
409}
410
411=head2 arch [-s] NAME
412
413Show the architecture of package C<NAME>.
414
415=cut 
416
417sub arch : XMLRPC {
418    my ($self, $c, $reqspec, @args) = @_;
419
420    $c->forward('qf', [ $reqspec, @args, '%{arch}' ]);
421}
422
423=head2 a
424
425Is an alias to C<arch> command.
426
427=cut 
428
429sub a : XMLRPC {
430    my ($self, $c, @args) = @_;
431    $c->forward('arch', [ @args ]);
432}
433
434=head2 url [-s] NAME
435
436Show the url of package C<NAME>.
437
438=cut 
439
440sub url : XMLRPC {
441    my ($self, $c, $reqspec, @args) = @_;
442
443    $c->forward('qf', [ $reqspec, @args, '%{url}' ]);
444}
445
446=head2 u
447
448Is an alias to C<url> command.
449
450=cut 
451
452sub u : XMLRPC {
453    my ($self, $c, @args) = @_;
454    $c->forward('url', [ @args ]);
455}
456
457=head2 group [-s] NAME
458
459Show the group of package C<NAME>.
460
461=cut 
462
463sub group : XMLRPC {
464    my ($self, $c, $reqspec, @args) = @_;
465
466    $c->forward('qf', [ $reqspec, @args, '%{group}' ]);
467}
468
469=head2 g
470
471Is an alias to C<group> command.
472
473=cut 
474
475sub g : XMLRPC {
476    my ($self, $c, @args) = @_;
477    $c->forward('group', [ @args ]);
478}
479
480=head2 license [-s] NAME
481
482Show the license of package C<NAME>.
483
484=cut 
485
486sub license : XMLRPC {
487    my ($self, $c, $reqspec, @args) = @_;
488
489    $c->forward('qf', [ $reqspec, @args, '%{license}' ]);
490}
491
492=head2 l
493
494Is an alias to C<license> command.
495
496=cut 
497
498sub l : XMLRPC {
499    my ($self, $c, @args) = @_;
500    $c->forward('license', [ @args ]);
501}
502
503=head2 buildtime [-s] NAME
504
505Show the build time of package C<NAME>.
506
507=cut
508
509sub buildtime : XMLRPC {
510    my ($self, $c, $reqspec, @args) = @_;
511
512    $c->forward('qf', [ $reqspec, @args, '%{buildtime:date}' ]);
513}
514
515=head2 builddate
516
517Is an alias for C<buildtime> command.
518
519=cut
520
521sub builddate : XMLRPC {
522    my ($self, $c, @args) = @_;
523    $c->forward('buildtime', [ @args ]);
524}
525
526=head2 builddate
527
528Is an alias for C<buildtime> command.
529
530=cut
531
532sub b : XMLRPC {
533    my ($self, $c, @args) = @_;
534    $c->forward('builddate', [ @args ]);
535}
536
537=head2 cookie [-s] NAME
538
539Show the C<cookie> tag of package C<NAME>.
540
541=cut
542
543sub cookie : XMLRPC {
544    my ($self, $c, $reqspec, @args) = @_;
545
546    $c->forward('qf', [ $reqspec, @args, '%{cookie}' ]);
547}
548
549=head2 sourcerpm NAME
550
551Show the C<sourcerpm> tag of package C<NAME>.
552
553=cut
554
555sub sourcerpm : XMLRPC {
556    my ($self, $c, $reqspec, @args) = @_;
557
558    $c->forward('qf', [ $reqspec, @args, '%{sourcerpm}' ]);
559}
560
561=head2 src NAME
562
563Is an alias for C<sourcerpm> command.
564
565=cut
566
567sub src : XMLRPC {
568    my ($self, $c, $reqspec, @args) = @_;
569
570    $c->forward('sourcerpm', [ $reqspec, @args ]);
571}
572
573=head2 rpmversion NAME
574
575Show the C<rpmversion> tag of package C<NAME>.
576
577=cut
578
579sub rpmversion : XMLRPC {
580    my ($self, $c, $reqspec, @args) = @_;
581
582    $c->forward('qf', [ $reqspec, @args, '%{rpmversion}' ]);
583}
584
585=head2 rpmbuildversion NAME
586
587Is an alias for C<rpmversion> command.
588
589=cut
590
591sub rpmbuildversion : XMLRPC {
592    my ($self, $c, $reqspec, @args) = @_;
593
594    $c->forward('rpmversion', [ $reqspec, @args ]);
595}
596
597
598=head2 buildhost NAME
599
600Show the C<buildhost> tag of package C<NAME>.
601
602=cut
603
604sub buildhost : XMLRPC {
605    my ($self, $c, $reqspec, @args) = @_;
606
607    $c->forward('qf', [ $reqspec, @args, '%{buildhost}' ]);
608}
609
610=head2 host NAME
611
612Is an alias for C<buildhost> command.
613
614=cut
615
616sub host : XMLRPC {
617    my ($self, $c, $reqspec, @args) = @_;
618
619    $c->forward('host', [ $reqspec, @args ]);
620}
621
622=head2 h NAME
623
624Is an alias for C<buildhost> command.
625
626=cut
627
628sub h : XMLRPC {
629    my ($self, $c, $reqspec, @args) = @_;
630
631    $c->forward('host', [ $reqspec, @args ]);
632}
633
634
635
636=head2 distribution NAME
637
638Show the C<distribution> tag of package C<NAME>.
639
640=cut
641
642sub distribution : XMLRPC {
643    my ($self, $c, $reqspec, @args) = @_;
644
645    $c->forward('qf', [ $reqspec, @args, '%{distribution}' ]);
646}
647
648=head2 distrib NAME
649
650Is an alias for C<distribution> command.
651
652=cut
653
654sub distrib : XMLRPC {
655    my ($self, $c, $reqspec, @args) = @_;
656
657    $c->forward('distribution', [ $reqspec, @args ]);
658}
659
660
661
662=head2 vendor NAME
663
664Show the C<vendor> tag of package C<NAME>.
665
666=cut
667
668sub vendor : XMLRPC {
669    my ($self, $c, $reqspec, @args) = @_;
670
671    $c->forward('qf', [ $reqspec, @args, '%{vendor}' ]);
672}
673
674
675
676sub qf : XMLRPC {
677    my ($self, $c, $reqspec, @args) = @_;
678    my @message;
679    $reqspec->{src} = 0;
680
681    @args = @{ $c->forward('_getopt', [
682        {
683            'd=s' => \$reqspec->{distribution},
684            'v=s' => \$reqspec->{release},
685            'a=s' => \$reqspec->{arch},
686            's'   => sub { $reqspec->{src} = 1 },
687        }, @args ]) };
688
689    @args == 2 or do {
690        $c->error('No argument given');
691        return;
692    };
693
694    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
695        return $c->stash->{xmlrpc} = {
696            message => [ "I don't have such distribution" ]
697        };
698    }
699
700    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
701    if (!@{ $rpmlist }) {
702        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
703        if ($else) {
704            return $c->stash->{xmlrpc} = {
705                message => [ 
706                    "There is no rpm named `$args[0]', but the word matches in " . $else
707                ],
708            }
709        } else {
710            return $c->stash->{xmlrpc} = {
711                message => [ "The rpm named `$args[0]' has not been found" ],
712            }
713        }
714    }
715    foreach (@{ $rpmlist }) {
716        my $info = $c->forward('/rpms/queryformat', [ $_, $args[1] ]);
717        push @message, $info . ' // ' .
718            $c->forward('_fmt_location', [ $reqspec, $_ ]);
719    }
720    return $c->stash->{xmlrpc} = {
721        message => \@message,
722    }
723}
724
725=head2 more NAME
726
727Show url where details about package named C<NAME> can be found
728
729=cut
730
731sub more : XMLRPC {
732    my ($self, $c, $reqspec, @args) = @_;
733    my @message;
734    $reqspec->{src} = 0;
735
736    @args = @{ $c->forward('_getopt', [
737        {
738            'd=s' => \$reqspec->{distribution},
739            'v=s' => \$reqspec->{release},
740            'a=s' => \$reqspec->{arch},
741            's'   => sub { $reqspec->{src} = 1 },
742        }, @args ]) };
743
744    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
745        return $c->stash->{xmlrpc} = {
746            message => [ "I don't have such distribution" ]
747        };
748    }
749
750    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
751    if (!@{ $rpmlist }) {
752        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
753        if ($else) {
754            return $c->stash->{xmlrpc} = {
755                message => [ 
756                    "There is no rpm named `$args[0]', but the word matches in " . $else
757                ],
758            }
759        } else {
760            return $c->stash->{xmlrpc} = {
761                message => [ "The rpm named `$args[0]' has not been found" ],
762            }
763        }
764    }
765    foreach (@{ $rpmlist }) {
766        push @message, $c->uri_for('/rpms', $_) . ' // ' .
767            $c->forward('_fmt_location', [ $reqspec, $_ ]);
768    }
769    return $c->stash->{xmlrpc} = {
770        message => \@message,
771    }
772}
773
774=head2 buildfrom NAME
775
776Return the list of package build from source package named C<NAME>
777
778=cut
779
780sub buildfrom : XMLRPC {
781    my ($self, $c, $reqspec, @args) = @_;
782    $reqspec->{src} = 1;
783    my @message;
784    @args = @{ $c->forward('_getopt', [
785        {
786            'd=s' => \$reqspec->{distribution},
787            'v=s' => \$reqspec->{release},
788            'a=s' => \$reqspec->{arch},
789        }, @args ]) };
790    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
791        return $c->stash->{xmlrpc} = {
792            message => [ "I don't have such distribution" ]
793        };
794    }
795    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
796    if (!@{ $rpmlist }) {
797        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
798        if ($else) {
799            return $c->stash->{xmlrpc} = {
800                message => [ 
801                    "There is no rpm named `$args[0]', but the word matches in " . $else
802                ],
803            }
804        } else {
805            return $c->stash->{xmlrpc} = {
806                message => [ "The rpm named `$args[0]' has not been found" ],
807            }
808        }
809    }
810    foreach (@{ $rpmlist }) {
811        my $res = $c->forward('/rpms/binaries', [ $_ ]);
812        my @name;
813        foreach (@$res) {
814            push(@name, $c->forward('/rpms/basicinfo', [ $_ ])->{name});
815        }
816        push(@message, join(', ', sort @name));
817    }
818    return $c->stash->{xmlrpc} = {
819        message => \@message,
820    }
821
822}
823
824=head2 findfile FILE
825
826Return the rpm owning the file C<FILE>.
827
828=cut
829
830sub findfile : XMLRPC {
831    my ($self, $c, $reqspec, @args) = @_;
832
833    my @message;
834    $reqspec->{src} = 0;
835
836    @args = @{ $c->forward('_getopt', [
837        {
838            'd=s' => \$reqspec->{distribution},
839            'v=s' => \$reqspec->{release},
840            'a=s' => \$reqspec->{arch},
841        }, @args ]) };
842
843    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
844        return $c->stash->{xmlrpc} = {
845            message => [ "I don't have such distribution" ]
846        };
847    }
848
849    my $rpmlist = $c->forward('/search/rpm/byfile', [ $reqspec, $args[0] ]);
850    if (!@{ $rpmlist }) {
851        return $c->stash->{xmlrpc} = {
852            message => [ "Sorry, no file $args[0] found" ],
853        }
854    } elsif (@{ $rpmlist } > 20) {
855        foreach (@{ $rpmlist }) {
856            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
857            push @message, $info->{name} . ' // ' .
858                $c->forward('_fmt_location', [ $reqspec, $_ ]);
859        }
860        return $c->stash->{xmlrpc} = {
861            message => \@message,
862        }
863    } else {
864        my %list;
865        foreach (@{ $rpmlist }) {
866            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
867            $list{$info->{name}} = 1;
868        }
869        return $c->stash->{xmlrpc} = {
870            message => [ join(', ', sort keys %list) ],
871        };
872    }
873}
874
875sub what : XMLRPC {
876    my ($self, $c, $reqspec, @args) = @_;
877       
878    @args = @{ $c->forward('_getopt', [
879        {
880            'd=s' => \$reqspec->{distribution},
881            'v=s' => \$reqspec->{release},
882            'a=s' => \$reqspec->{arch},
883            's'   => \$reqspec->{src},
884        }, @args ]) };
885
886    my ($type, $depname, $sense, $evr) = @args;
887
888    my $deptype = uc(substr($type, 0, 1));
889    my $rpmlist = $c->forward('/search/rpm/bydep',
890        [ $reqspec, $deptype, $depname, $sense, $evr ]);
891
892    if (@{ $rpmlist } < 20) {
893        my @name;
894        foreach (@{ $rpmlist }) {
895            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
896            push @name, $info->{name} . '-' . $info->{evr};
897        }
898        return $c->stash->{xmlrpc} = {
899            message => [
900                "Package matching $depname" . ($evr ? " $sense $evr" : '') .
901                ':', 
902                join(' ', @name),
903            ],
904        }
905    } else {
906        return $c->stash->{xmlrpc} = {
907            message => [ 'Too many result' ],
908        };
909    }
910
911}
912
913=head2 maint RPMNAME
914
915Show the maintainers for the rpm named C<RPMNAME>.
916
917=cut
918
919sub maint : XMLRPC {
920    my ($self, $c, $reqspec, @args) = @_;
921    $reqspec->{src} = 0;
922    my @message;
923    @args = @{ $c->forward('_getopt', [
924        {
925            'd=s' => \$reqspec->{distribution},
926            'v=s' => \$reqspec->{release},
927            'a=s' => \$reqspec->{arch},
928        }, @args ]) };
929    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
930        return $c->stash->{xmlrpc} = {
931            message => [ "I don't have such distribution" ]
932        };
933    }
934    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
935    if (!@{ $rpmlist }) {
936        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
937        if ($else) {
938            return $c->stash->{xmlrpc} = {
939                message => [ 
940                    "There is no rpm named `$args[0]', but the word matches in " . $else
941                ],
942            }
943        } else {
944            return $c->stash->{xmlrpc} = {
945                message => [ "The rpm named `$args[0]' has not been found" ],
946            }
947        }
948    }
949    my %maint;
950    foreach (@{ $rpmlist }) {
951        my $res = $c->forward('/rpms/maintainers', [ $_ ]);
952        foreach (@$res) {
953            my $m = 'For ' . $_->{vendor} . ': ' . $_->{owner};
954            $maint{$m} = 1;
955        }
956    }
957    return $c->stash->{xmlrpc} = {
958        message => [ sort keys %maint ],
959    }
960}
961
962=head1 AUTHOR
963
964Olivier Thauvin
965
966=head1 LICENSE
967
968This library is free software. You can redistribute it and/or modify
969it under the same terms as Perl itself.
970
971=cut
972
973__PACKAGE__->meta->make_immutable;
974
9751;
Note: See TracBrowser for help on using the repository browser.