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

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