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

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