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

Last change on this file since 240 was 240, checked in by nanardon, 13 years ago
  • bot help give url help on website
  • Property svn:keywords set to Id Rev
File size: 17.4 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 $id = $c->forward('/chat/paste', [ 'Bot paste', join("\n", @backup) ]);
50        if ($id) {
51            push(@{ $message->{message} }, 'All results available here: ' . $c->uri_for('/chat', $id));
52        }
53    }
54
55    $c->stash->{xmlrpc} = $message;
56
57    $c->forward('/end');
58}
59
60=head1 BOT COMMAND
61
62=head2 REPLY
63
64=cut
65
66sub _commands {
67    my ( $self, $c ) = @_;
68    [ grep { m/^[^_]/ } map { $_->name } $self->get_action_methods() ];
69}
70
71sub _getopt : Private {
72    my ( $self, $c, $options, @args) = @_;
73
74    local @ARGV = @args;
75
76    GetOptions(%{ $options || {} });
77
78    return \@ARGV;
79}
80
81sub _fmt_location : Private {
82    my ($self, $c, $searchspec, $pkgid) = @_;
83
84    my @loc;
85    foreach (@{ $c->forward('/rpms/location', [ $pkgid ]) }) {
86        push @loc, sprintf(
87            '%s (%s, %s, %s)',
88            $_->{media},
89            $_->{dist} || $_->{distribution},
90            $_->{release},
91            $_->{arch},
92        );
93    }
94    return join(', ', @loc);
95}
96
97sub _find_rpm_elsewhere : Private {
98    my ($self, $c, $searchspec, $name) = @_;
99    if ($searchspec->{distribution}) {
100        my $rpmlist = $c->forward('/search/rpm/byname', [ 
101                {
102                    distribution => $searchspec->{distribution},
103                    rows => 1,
104                }, $name ]);
105        if (@{$rpmlist}) {
106            return $c->forward('_fmt_location', [ { 
107                        distribution => $searchspec->{distribution}
108                    }, $rpmlist->[0] ]);
109        }
110    }
111    my $rpmlist = $c->forward('/search/rpm/byname', [ {}, $name ]);
112    my %dist;
113    foreach(@$rpmlist) {
114        foreach (@{ $c->forward('/rpms/location', [ $_ ]) }) {
115            $dist{$_->{dist} || $_->{distribution}} = 1;
116        }
117    }
118    if (keys %dist) {
119        return join(', ', sort keys %dist);
120    }
121    return;
122}
123
124=head1 AVAILLABLE FUNCTIONS
125
126=cut
127
128=head2 help [cmd]
129
130Return help about command cmd or list available command.
131
132=cut
133
134sub help : XMLRPC {
135    my ( $self, $c, $reqspec, $cmd ) = @_;
136    if ($cmd) {
137        my @message = grep { /\S+/ } split(/\n/,
138            $c->model('Help::POD')->bot_help_text($cmd) || 'No help available');
139        return $c->{stash}->{xmlrpc} = {
140            private_reply => 1,
141            message => \@message,
142        };
143    } else {
144        return $c->{stash}->{xmlrpc} = {
145            private_reply => 1,
146            message => [
147                'available command:',
148                join(', ', sort grep { $_ !~ /^end$/ } @{ $self->_commands }),
149                'Find more at ' . $c->uri_for('/help/chat'),
150            ],
151        }
152    }
153}
154
155=head2 asv
156
157ASV means in french "age, sexe, ville" (age, sex and town).
158Return the version of the Chat module version.
159
160=cut
161
162sub asv : XMLRPC {
163    my ( $self, $c ) = @_;
164    return $c->stash->{xmlrpc} = {
165        message => [ 'Sophie: ' . $Sophie::VERSION . ', Chat ' . q$Rev$ ],
166    };
167}
168
169=head2 q REGEXP
170
171Search rpm name matching C<REGEXP>.
172
173NB: C<.>, C<*>, C<+> have special meaning
174and have to be escaped.
175
176=cut
177
178sub q : XMLRPC {
179    my ($self, $c, $reqspec, @args) = @_;
180
181    $reqspec->{src} = 0;
182
183    @args = @{ $c->forward('_getopt', [
184        {
185            'd=s' => \$reqspec->{distribution},
186            'v=s' => \$reqspec->{release},
187            'a=s' => \$reqspec->{arch},
188            's'   => sub { $reqspec->{src} = 1 },
189        }, @args ]) };
190
191    my $res = $c->forward('/search/tags/name_regexp', $reqspec, $args[0]);
192    if (!@{ $res }) {
193        return $c->stash->{xmlrpc} = {
194            message => [ 'Nothing match `' . $args[0] . '\'' ]
195        };
196    } else {
197        my @message = 'rpm name matching `' . $args[0] . '\':';
198        while (@{ $res }) {
199            my $str = '';
200            do {
201                my $item = shift(@{ $res }) or last;
202                $str .= ', ' if ($str);
203                $str .= $item->{name};
204            } while (length($str) < 70);
205            push(@message, $str);
206        }
207        return $c->stash->{xmlrpc} = {
208            message => \@message,
209        };
210    }
211}
212
213=head2 version [-s] NAME
214
215Show the version of package C<NAME>.
216
217=cut
218
219sub version : XMLRPC {
220    my ($self, $c, $reqspec, @args) = @_;
221
222    my @message;
223    $reqspec->{src} = 0;
224
225    @args = @{ $c->forward('_getopt', [
226        {
227            'd=s' => \$reqspec->{distribution},
228            'v=s' => \$reqspec->{release},
229            'a=s' => \$reqspec->{arch},
230            's'   => sub { $reqspec->{src} = 1 },
231        }, @args ]) };
232
233    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
234        return $c->stash->{xmlrpc} = {
235            message => [ "I don't have such distribution" ]
236        };
237    }
238
239    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
240    if (!@{ $rpmlist }) {
241        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
242        if ($else) {
243            return $c->stash->{xmlrpc} = {
244                message => [ 
245                    "The rpm named `$args[0]' has not been found but found in " . $else
246                ],
247            }
248        } else {
249            return $c->stash->{xmlrpc} = {
250                message => [ "The rpm named `$args[0]' has not been found" ],
251            }
252        }
253    }
254    foreach (@{ $rpmlist }) {
255        my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
256        push @message, $info->{evr} . ' // ' .
257            $c->forward('_fmt_location', [ $reqspec, $_ ]);
258    }
259    return $c->stash->{xmlrpc} = {
260        message => \@message,
261    }
262}
263
264=head2 v
265
266C<v> is an alias for L<version> command.
267
268=cut
269
270sub v : XMLRPC {
271    my ($self, $c, @args) = @_;
272    $c->forward('version', [ @args ]);
273}
274
275=head2 summary [-s] NAME
276
277Show the summary of package C<NAME>.
278
279=cut
280
281sub summary : XMLRPC {
282    my ($self, $c, $reqspec, @args) = @_;
283
284    $c->forward('qf', [ $reqspec, @args, '%{summary}' ]);
285}
286
287=head2 s
288
289Is an alias for C<summary> command.
290
291=cut
292
293sub s : XMLRPC {
294    my ($self, $c, @args) = @_;
295    $c->forward('summary', [ @args ]);
296}
297
298=head2 packager [-s] NAME
299
300Show the packager of package C<NAME>.
301
302=cut
303
304sub packager : XMLRPC {
305    my ($self, $c, $reqspec, @args) = @_;
306
307    $c->forward('qf', [ $reqspec, @args, '%{packager}' ]);
308}
309
310=head2 p
311
312Is an alias for C<packager> command.
313
314=cut
315
316sub p : XMLRPC {
317    my ($self, $c, @args) = @_;
318    $c->forward('packager', [ @args ]);
319}
320
321=head2 arch [-s] NAME
322
323Show the architecture of package C<NAME>.
324
325=cut 
326
327sub arch : XMLRPC {
328    my ($self, $c, $reqspec, @args) = @_;
329
330    $c->forward('qf', [ $reqspec, @args, '%{arch}' ]);
331}
332
333=head2 a
334
335Is an alias to C<arch> command.
336
337=cut 
338
339sub a : XMLRPC {
340    my ($self, $c, @args) = @_;
341    $c->forward('arch', [ @args ]);
342}
343
344=head2 url [-s] NAME
345
346Show the url of package C<NAME>.
347
348=cut 
349
350sub url : XMLRPC {
351    my ($self, $c, $reqspec, @args) = @_;
352
353    $c->forward('qf', [ $reqspec, @args, '%{url}' ]);
354}
355
356=head2 u
357
358Is an alias to C<url> command.
359
360=cut 
361
362sub u : XMLRPC {
363    my ($self, $c, @args) = @_;
364    $c->forward('url', [ @args ]);
365}
366
367=head2 group [-s] NAME
368
369Show the group of package C<NAME>.
370
371=cut 
372
373sub group : XMLRPC {
374    my ($self, $c, $reqspec, @args) = @_;
375
376    $c->forward('qf', [ $reqspec, @args, '%{group}' ]);
377}
378
379=head2 g
380
381Is an alias to C<group> command.
382
383=cut 
384
385sub g : XMLRPC {
386    my ($self, $c, @args) = @_;
387    $c->forward('group', [ @args ]);
388}
389
390=head2 license [-s] NAME
391
392Show the license of package C<NAME>.
393
394=cut 
395
396sub license : XMLRPC {
397    my ($self, $c, $reqspec, @args) = @_;
398
399    $c->forward('qf', [ $reqspec, @args, '%{license}' ]);
400}
401
402=head2 l
403
404Is an alias to C<license> command.
405
406=cut 
407
408sub l : XMLRPC {
409    my ($self, $c, @args) = @_;
410    $c->forward('license', [ @args ]);
411}
412
413=head2 buildtime [-s] NAME
414
415Show the build time of package C<NAME>.
416
417=cut
418
419sub buildtime : XMLRPC {
420    my ($self, $c, $reqspec, @args) = @_;
421
422    $c->forward('qf', [ $reqspec, @args, '%{buildtime:date}' ]);
423}
424
425=head2 builddate
426
427Is an alias for C<buildtime> command.
428
429=cut
430
431sub builddate : XMLRPC {
432    my ($self, $c, @args) = @_;
433    $c->forward('buildtime', [ @args ]);
434}
435
436=head2 builddate
437
438Is an alias for C<buildtime> command.
439
440=cut
441
442sub b : XMLRPC {
443    my ($self, $c, @args) = @_;
444    $c->forward('builddate', [ @args ]);
445}
446
447=head2 cookie [-s] NAME
448
449Show the C<cookie> tag of package C<NAME>.
450
451=cut
452
453sub cookie : XMLRPC {
454    my ($self, $c, $reqspec, @args) = @_;
455
456    $c->forward('qf', [ $reqspec, @args, '%{cookie}' ]);
457}
458
459=head2 qf rpmname format
460
461Perform an rpm -q --qf on package named C<rpmname>
462
463=cut
464
465sub qf : XMLRPC {
466    my ($self, $c, $reqspec, @args) = @_;
467    my @message;
468    $reqspec->{src} = 0;
469
470    @args = @{ $c->forward('_getopt', [
471        {
472            'd=s' => \$reqspec->{distribution},
473            'v=s' => \$reqspec->{release},
474            'a=s' => \$reqspec->{arch},
475            's'   => sub { $reqspec->{src} = 1 },
476        }, @args ]) };
477
478    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
479        return $c->stash->{xmlrpc} = {
480            message => [ "I don't have such distribution" ]
481        };
482    }
483
484    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
485    if (!@{ $rpmlist }) {
486        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
487        if ($else) {
488            return $c->stash->{xmlrpc} = {
489                message => [ 
490                    "The rpm named `$args[0]' has not been found but found in " . $else
491                ],
492            }
493        } else {
494            return $c->stash->{xmlrpc} = {
495                message => [ "The rpm named `$args[0]' has not been found" ],
496            }
497        }
498    }
499    foreach (@{ $rpmlist }) {
500        my $info = $c->forward('/rpms/queryformat', [ $_, $args[1] ]);
501        push @message, $info . ' // ' .
502            $c->forward('_fmt_location', [ $reqspec, $_ ]);
503    }
504    return $c->stash->{xmlrpc} = {
505        message => \@message,
506    }
507}
508
509=head2 more NAME
510
511Show url where details about package named C<NAME> can be found
512
513=cut
514
515sub more : XMLRPC {
516    my ($self, $c, $reqspec, @args) = @_;
517    my @message;
518    $reqspec->{src} = 0;
519
520    @args = @{ $c->forward('_getopt', [
521        {
522            'd=s' => \$reqspec->{distribution},
523            'v=s' => \$reqspec->{release},
524            'a=s' => \$reqspec->{arch},
525            's'   => sub { $reqspec->{src} = 1 },
526        }, @args ]) };
527
528    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
529        return $c->stash->{xmlrpc} = {
530            message => [ "I don't have such distribution" ]
531        };
532    }
533
534    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
535    if (!@{ $rpmlist }) {
536        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
537        if ($else) {
538            return $c->stash->{xmlrpc} = {
539                message => [ 
540                    "The rpm named `$args[0]' has not been found but found in " . $else
541                ],
542            }
543        } else {
544            return $c->stash->{xmlrpc} = {
545                message => [ "The rpm named `$args[0]' has not been found" ],
546            }
547        }
548    }
549    foreach (@{ $rpmlist }) {
550        push @message, $c->uri_for('/rpms', $_) . ' // ' .
551            $c->forward('_fmt_location', [ $reqspec, $_ ]);
552    }
553    return $c->stash->{xmlrpc} = {
554        message => \@message,
555    }
556}
557
558=head2 buildfrom NAME
559
560Return the list of package build from source package named C<NAME>
561
562=cut
563
564sub buildfrom : XMLRPC {
565    my ($self, $c, $reqspec, @args) = @_;
566    $reqspec->{src} = 1;
567    my @message;
568    @args = @{ $c->forward('_getopt', [
569        {
570            'd=s' => \$reqspec->{distribution},
571            'v=s' => \$reqspec->{release},
572            'a=s' => \$reqspec->{arch},
573        }, @args ]) };
574    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
575        return $c->stash->{xmlrpc} = {
576            message => [ "I don't have such distribution" ]
577        };
578    }
579    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
580    if (!@{ $rpmlist }) {
581        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
582        if ($else) {
583            return $c->stash->{xmlrpc} = {
584                message => [ 
585                    "The rpm named `$args[0]' has not been found but found in " . $else
586                ],
587            }
588        } else {
589            return $c->stash->{xmlrpc} = {
590                message => [ "The rpm named `$args[0]' has not been found" ],
591            }
592        }
593    }
594    foreach (@{ $rpmlist }) {
595        my $res = $c->forward('/rpms/binaries', [ $_ ]);
596        my @name;
597        foreach (@$res) {
598            push(@name, $c->forward('/rpms/basicinfo', [ $_ ])->{name});
599        }
600        push(@message, join(', ', sort @name));
601    }
602    return $c->stash->{xmlrpc} = {
603        message => \@message,
604    }
605
606}
607
608=head2 findfile FILE
609
610Return the rpm owning the file C<FILE>.
611
612=cut
613
614sub findfile : XMLRPC {
615    my ($self, $c, $reqspec, @args) = @_;
616
617    my @message;
618    $reqspec->{src} = 0;
619
620    @args = @{ $c->forward('_getopt', [
621        {
622            'd=s' => \$reqspec->{distribution},
623            'v=s' => \$reqspec->{release},
624            'a=s' => \$reqspec->{arch},
625        }, @args ]) };
626
627    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
628        return $c->stash->{xmlrpc} = {
629            message => [ "I don't have such distribution" ]
630        };
631    }
632
633    my $rpmlist = $c->forward('/search/rpm/byfile', [ $reqspec, $args[0] ]);
634    if (!@{ $rpmlist }) {
635        return $c->stash->{xmlrpc} = {
636            message => [ "Sorry, no file $args[0] found" ],
637        }
638    } elsif (@{ $rpmlist } > 20) {
639        foreach (@{ $rpmlist }) {
640            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
641            push @message, $info->{name} . ' // ' .
642                $c->forward('_fmt_location', [ $reqspec, $_ ]);
643        }
644        return $c->stash->{xmlrpc} = {
645            message => \@message,
646        }
647    } else {
648        my %list;
649        foreach (@{ $rpmlist }) {
650            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
651            $list{$info->{name}} = 1;
652        }
653        return $c->stash->{xmlrpc} = {
654            message => [ join(', ', sort keys %list) ],
655        };
656    }
657}
658
659sub what : XMLRPC {
660    my ($self, $c, $reqspec, @args) = @_;
661       
662    @args = @{ $c->forward('_getopt', [
663        {
664            'd=s' => \$reqspec->{distribution},
665            'v=s' => \$reqspec->{release},
666            'a=s' => \$reqspec->{arch},
667            's'   => \$reqspec->{src},
668        }, @args ]) };
669
670    my ($type, $depname, $sense, $evr) = @args;
671
672    my $deptype = uc(substr($type, 0, 1));
673    my $rpmlist = $c->forward('/search/rpm/bydep',
674        [ $reqspec, $deptype, $depname, $sense, $evr ]);
675
676    if (@{ $rpmlist } < 20) {
677        my @name;
678        foreach (@{ $rpmlist }) {
679            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
680            push @name, $info->{name} . '-' . $info->{evr};
681        }
682        return $c->stash->{xmlrpc} = {
683            message => [
684                "Package matching $depname" . ($evr ? " $sense $evr" : '') .
685                ':', 
686                join(' ', @name),
687            ],
688        }
689    } else {
690        return $c->stash->{xmlrpc} = {
691            message => [ 'Too many result' ],
692        };
693    }
694
695}
696
697=head2 maint RPMNAME
698
699Show the maintainers for the rpm named C<RPMNAME>.
700
701=cut
702
703sub maint : XMLRPC {
704    my ($self, $c, $reqspec, @args) = @_;
705    $reqspec->{src} = 0;
706    my @message;
707    @args = @{ $c->forward('_getopt', [
708        {
709            'd=s' => \$reqspec->{distribution},
710            'v=s' => \$reqspec->{release},
711            'a=s' => \$reqspec->{arch},
712        }, @args ]) };
713    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
714        return $c->stash->{xmlrpc} = {
715            message => [ "I don't have such distribution" ]
716        };
717    }
718    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
719    if (!@{ $rpmlist }) {
720        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
721        if ($else) {
722            return $c->stash->{xmlrpc} = {
723                message => [ 
724                    "The rpm named `$args[0]' has not been found but found in " . $else
725                ],
726            }
727        } else {
728            return $c->stash->{xmlrpc} = {
729                message => [ "The rpm named `$args[0]' has not been found" ],
730            }
731        }
732    }
733    my %maint;
734    foreach (@{ $rpmlist }) {
735        my $res = $c->forward('/rpms/maintainers', [ $_ ]);
736        foreach (@$res) {
737            my $m = 'For ' . $_->{vendor} . ': ' . $_->{owner};
738            $maint{$m} = 1;
739        }
740    }
741    return $c->stash->{xmlrpc} = {
742        message => [ sort keys %maint ],
743    }
744}
745
746=head1 AUTHOR
747
748Olivier Thauvin
749
750=head1 LICENSE
751
752This library is free software. You can redistribute it and/or modify
753it under the same terms as Perl itself.
754
755=cut
756
757__PACKAGE__->meta->make_immutable;
758
7591;
Note: See TracBrowser for help on using the repository browser.