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

Last change on this file since 386 was 386, checked in by grenoya, 13 years ago
  • return error message when :set and :unset are not used correcly
  • Property svn:keywords set to Id Rev
File size: 29.8 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 _fmt_question : Private {
101    my ($self, $c, $searchspec) = @_;
102
103    my $loc;
104    $loc = sprintf(
105        '(%s, %s, %s)',
106        $searchspec->{dist} || $searchspec->{distribution} || "*",
107        $searchspec->{release} || "*",
108        $searchspec->{arch} || "*",
109    );
110   
111    return $loc;
112}
113
114sub _find_rpm_elsewhere : Private {
115    my ($self, $c, $searchspec, $name) = @_;
116    if ($searchspec->{distribution}) {
117        my $rpmlist = $c->forward('/search/rpm/byname', [ 
118                {
119                    distribution => $searchspec->{distribution},
120                    src => $searchspec->{src},
121                    rows => 1,
122                }, $name ]);
123        if (@{$rpmlist}) {
124            return $c->forward('_fmt_location', [ { 
125                        distribution => $searchspec->{distribution}
126                    }, $rpmlist->[0] ]);
127        }
128    }
129    my $rpmlist = $c->forward('/search/rpm/byname', [ { src =>
130                $searchspec->{src}}, $name ]);
131    my %dist;
132    foreach(@$rpmlist) {
133        foreach (@{ $c->forward('/rpms/location', [ $_ ]) }) {
134            $dist{$_->{dist} || $_->{distribution}} = 1;
135        }
136    }
137    if (keys %dist) {
138        return join(', ', sort keys %dist);
139    }
140    return;
141}
142
143=head1 AVAILABLE FUNCTIONS
144
145=cut
146
147=head2 help [cmd]
148
149Return help about command cmd or list available command.
150
151=cut
152
153sub help : XMLRPC {
154    my ( $self, $c, $reqspec, $cmd ) = @_;
155    if ($cmd) {
156        my @message = grep { /\S+/ } split(/\n/,
157            $c->model('Help::POD')->bot_help_text($cmd) || 'No help available');
158        return $c->{stash}->{xmlrpc} = {
159            private_reply => 1,
160            message => \@message,
161        };
162    } else {
163        return $c->{stash}->{xmlrpc} = {
164            private_reply => 1,
165            message => [
166                'available command:',
167                join(', ', sort grep { $_ !~ /^end$/ } @{ $self->_commands }),
168                'Find more at ' . $c->uri_for('/help/chat'),
169            ],
170        }
171    }
172}
173
174=head2 set [distribution|release|arch] value
175
176Set default search value (see also: unset)
177
178=cut
179
180sub set : XMLRPC {
181    my ( $self, $c, $reqspec, $var, $val ) = @_;
182
183    if (!$var) {
184        return $c->stash->{xmlrpc} = {
185            private_reply => 1,
186            message => [
187                "What must I set ?"
188            ]
189        }
190    } 
191   
192    if (!$val) {
193        return $c->stash->{xmlrpc} = {
194            private_reply => 1,
195            message => [
196                "To what must I set $var ?"
197            ]
198        }
199    } 
200   
201    $c->forward('/user/update_data', [ $reqspec->{from}, { $var => $val } ]);
202
203    return $c->stash->{xmlrpc} = {
204        private_reply => 1,
205        message => [
206            "$var set to: " . ($val || '(none)'),
207            ($c->forward('/distrib/exists', [
208                    $c->forward('/user/fetchdata', [ $reqspec->{from}, ]) ])
209                ? ()
210                : ("warning: your setting does not match any distribution")
211            ),
212        ]
213    };
214}
215
216=head2 unset [distribution|release|arch]
217
218Unset default search value (see also: set)
219
220=cut
221
222sub unset : XMLRPC {
223    my ( $self, $c, $reqspec, $var ) = @_;
224
225
226    if (!$var) {
227        return $c->stash->{xmlrpc} = {
228            private_reply => 1,
229            message => [
230                "What must I unset ?"
231            ]
232        }
233    } 
234   
235    $c->forward('/user/update_data', [ $reqspec->{from}, { $var => undef } ]);
236   
237    return $c->stash->{xmlrpc} = {
238        private_reply => 1,
239        message => [ "$var set to: (none)" ],
240    };
241}
242
243=head2 show [var]
244
245Show your user settings
246
247=cut
248
249sub show : XMLRPC {
250    my ( $self, $c, $reqspec, $var, ) = @_;
251
252    my $res = $c->forward('/user/fetchdata', [ $reqspec->{from}, ]);
253   
254    if ($var) {
255        my $own = $res->{$var} || '(none)';
256        my $applied = $reqspec->{$var} || '(none)';
257        return $c->stash->{xmlrpc} = {
258            message => [ sprintf("%s is set to %s%s",
259                $var,
260                $own,
261                ($own ne $applied
262                    ? " ($applied is used in this context)"
263                    : '')
264            ) ]
265        };
266    } else {
267        my $own = $c->forward('_fmt_question', [$res]);
268        my $applied = $c->forward('_fmt_question', [$reqspec]);
269
270        return $c->stash->{xmlrpc} = {
271            message => [ sprintf('your setting is: %s%s',
272                $own,
273                ($own ne $applied
274                    ? " ($applied is used in this context)"
275                    : ''
276                )
277            ),
278            ($c->forward('/distrib/exists', [ $res ])
279                ? ()
280                : ("warning: your setting does not match any distribution")
281            )
282            ],
283        }
284    }
285}
286
287=head2 asv
288
289ASV means in french "age, sexe, ville" (age, sex and town).
290Return the version of the Chat module version.
291
292=cut
293
294sub asv : XMLRPC {
295    my ( $self, $c ) = @_;
296    return $c->stash->{xmlrpc} = {
297        message => [ 'Sophie: ' . $Sophie::VERSION . ', Chat ' . q$Rev$ ],
298    };
299}
300
301=head2 list [distribution [release [arch]]]
302
303List available distribution, release, architecture matching given arguments.
304
305=cut
306
307sub list : XMLRPC {
308    my ($self, $c, $reqspec, @args) = @_;
309
310    my $distrib = {
311        distribution => $args[0],
312        release      => $args[1],
313        arch         => $args[2],
314    };
315
316    if (!$c->forward('/distrib/exists', [ $distrib ])) {
317        return $c->stash->{xmlrpc} = {
318            message => [ "I don't have any distribution matching: "
319                         . join(' / ', grep { $_ } @args[0..2]) ],
320        };
321    }
322
323    my @list = @{ $c->forward('/distrib/list', [ $distrib ]) };
324    return $c->stash->{xmlrpc} = {
325        message => [ 
326            ($args[0] 
327                ? join(' / ', grep { $_ } @args[0..2]) . ': '
328                : '') .
329            join(', ', @list) ],
330    }
331}
332
333=head2 q [-d distrib] [-r release] [-a arch] [-s]  REGEXP
334
335Search rpm name matching C<REGEXP>.
336
337NB: C<.>, C<*>, C<+> have special meaning
338and have to be escaped.
339
340=cut
341
342sub q : XMLRPC {
343    my ($self, $c, $reqspec, @args) = @_;
344
345    $reqspec->{src} = 0;
346
347    @args = @{ $c->forward('_getopt', [
348        {
349            'd=s' => \$reqspec->{distribution},
350            'v=s' => \$reqspec->{release},
351            'r=s' => \$reqspec->{release},
352            'a=s' => \$reqspec->{arch},
353            's'   => sub { $reqspec->{src} = 1 },
354        }, @args ]) };
355
356    my $res = $c->forward('/search/tags/name_regexp', $reqspec, $args[0]);
357    warn join(' ', @{ $res });
358    if (!@{ $res }) {
359        return $c->stash->{xmlrpc} = {
360            message => [ "Nothing matches `$args[0]' in "
361                    .$c->forward('_fmt_question', [$reqspec])],
362        };
363    } else {
364        my @message = "rpm name matching `$args[0]' in "
365                    .$c->forward('_fmt_question', [$reqspec])." :";
366        while (@{ $res }) {
367            my $str = '';
368            while (length($str) < 70) {
369                my $item = shift(@{ $res }) or last;
370                $str .= ', ' if ($str);
371                $str .= $item->{name};
372            }
373            push(@message, $str);
374        }
375        return $c->stash->{xmlrpc} = {
376            message => \@message,
377        };
378    }
379}
380
381=head2 whatis [-d distrib] [-r release] [-a arch] [-s]  WORD [WORD2 [...]]
382
383Search rpm having description containing words given as arguments
384
385=cut
386
387sub whatis : XMLRPC {
388    my ($self, $c, $reqspec, @args) = @_;
389
390    $reqspec->{src} = 0;
391
392    @args = @{ $c->forward('_getopt', [
393        {
394            'd=s' => \$reqspec->{distribution},
395            'v=s' => \$reqspec->{release},
396            'r=s' => \$reqspec->{release},
397            'a=s' => \$reqspec->{arch},
398            's'   => sub { $reqspec->{src} = 1 },
399        }, @args ]) };
400    my $res = $c->forward('/search/rpm/description', [ $reqspec, @args ]);
401
402    if (@{ $res }) {
403        if (@{ $res } > 100) {
404            return $c->stash->{xmlrpc} = {
405                message => [ 'I have ' . @{ $res } . ' results in '
406                    .$c->forward('_fmt_question', [$reqspec])],
407            };
408        } else {
409            my @names = ();
410            foreach (@{ $res }) {
411                my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
412                push(@names, $info->{name});
413            }
414            my @message = "rpm name matching `$args[0]' in "
415                    .$c->forward('_fmt_question', [$reqspec])." :";
416            while (@names) {
417                my $str = '';
418                while (length($str) < 70) {
419                    my $item = shift(@names) or last;
420                    $str .= ', ' if ($str);
421                    $str .= $item;
422                }
423                push(@message, $str);
424            }
425            return $c->stash->{xmlrpc} = {
426                message => \@message,
427            };
428        }
429    } else {
430        return $c->stash->{xmlrpc} = {
431            message => [ 'No rpm description matches this keywords in '
432                    .$c->forward('_fmt_question', [$reqspec])],
433        };
434    }
435}
436
437=head2 version [-d distrib] [-r release] [-a arch] [-s] NAME
438
439Show the version of package C<NAME>.
440
441=cut
442
443sub version : XMLRPC {
444    my ($self, $c, $reqspec, @args) = @_;
445
446    my @message;
447    $reqspec->{src} = 0;
448
449    @args = @{ $c->forward('_getopt', [
450        {
451            'd=s' => \$reqspec->{distribution},
452            'v=s' => \$reqspec->{release},
453            'r=s' => \$reqspec->{release},
454            'a=s' => \$reqspec->{arch},
455            's'   => sub { $reqspec->{src} = 1 },
456        }, @args ]) };
457
458    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
459        return $c->stash->{xmlrpc} = {
460            message => [ "I don't have such distribution : " 
461                    .$c->forward('_fmt_question', [$reqspec])],
462        };
463    }
464
465    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
466    if (!@{ $rpmlist }) {
467        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
468        if ($else) {
469            return $c->stash->{xmlrpc} = {
470                message => [ 
471                    "There is no rpm named `$args[0]' in "
472                    .$c->forward('_fmt_question', [$reqspec])
473                    .", but the word matches in " . $else
474                ],
475            }
476        } else {
477            return $c->stash->{xmlrpc} = {
478                message => [ "The rpm named `$args[0]' has not been found in "
479                    .$c->forward('_fmt_question', [$reqspec])],
480            }
481        }
482    }
483    foreach (@{ $rpmlist }) {
484        my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
485        push @message, $info->{evr} . ' // ' .
486            $c->forward('_fmt_location', [ $reqspec, $_ ]);
487    }
488    return $c->stash->{xmlrpc} = {
489        message => [ @message ],
490    }
491}
492
493=head2 v
494
495C<v> is an alias for C<version> command.
496
497=cut
498
499sub v : XMLRPC {
500    my ($self, $c, @args) = @_;
501    $c->forward('version', [ @args ]);
502}
503
504=head2 summary [-d distrib] [-r release] [-a arch] [-s]  NAME
505
506Show the summary of package C<NAME>.
507
508=cut
509
510sub summary : XMLRPC {
511    my ($self, $c, $reqspec, @args) = @_;
512
513    $c->forward('qf', [ $reqspec, @args, '%{summary}' ]);
514}
515
516=head2 s
517
518Is an alias for C<summary> command.
519
520=cut
521
522sub s : XMLRPC {
523    my ($self, $c, @args) = @_;
524    $c->forward('summary', [ @args ]);
525}
526
527=head2 packager [-d distrib] [-r release] [-a arch] [-s]  NAME
528
529Show the packager of package C<NAME>.
530
531=cut
532
533sub packager : XMLRPC {
534    my ($self, $c, $reqspec, @args) = @_;
535
536    $c->forward('qf', [ $reqspec, @args, '%{packager}' ]);
537}
538
539=head2 p
540
541Is an alias for C<packager> command.
542
543=cut
544
545sub p : XMLRPC {
546    my ($self, $c, @args) = @_;
547    $c->forward('packager', [ @args ]);
548}
549
550=head2 arch [-d distrib] [-r release] [-a arch] [-s]  NAME
551
552Show the architecture of package C<NAME>.
553
554=cut 
555
556sub arch : XMLRPC {
557    my ($self, $c, $reqspec, @args) = @_;
558
559    $c->forward('qf', [ $reqspec, @args, '%{arch}' ]);
560}
561
562=head2 a
563
564Is an alias to C<arch> command.
565
566=cut 
567
568sub a : XMLRPC {
569    my ($self, $c, @args) = @_;
570    $c->forward('arch', [ @args ]);
571}
572
573=head2 url [-d distrib] [-r release] [-a arch] [-s]  NAME
574
575Show the url of package C<NAME>.
576
577=cut 
578
579sub url : XMLRPC {
580    my ($self, $c, $reqspec, @args) = @_;
581
582    $c->forward('qf', [ $reqspec, @args, '%{url}' ]);
583}
584
585=head2 u
586
587Is an alias to C<url> command.
588
589=cut 
590
591sub u : XMLRPC {
592    my ($self, $c, @args) = @_;
593    $c->forward('url', [ @args ]);
594}
595
596=head2 group [-d distrib] [-r release] [-a arch] [-s] NAME
597
598Show the group of package C<NAME>.
599
600=cut 
601
602sub group : XMLRPC {
603    my ($self, $c, $reqspec, @args) = @_;
604
605    $c->forward('qf', [ $reqspec, @args, '%{group}' ]);
606}
607
608=head2 g
609
610Is an alias to C<group> command.
611
612=cut 
613
614sub g : XMLRPC {
615    my ($self, $c, @args) = @_;
616    $c->forward('group', [ @args ]);
617}
618
619=head2 license [-d distrib] [-r release] [-a arch] [-s] NAME
620
621Show the license of package C<NAME>.
622
623=cut 
624
625sub license : XMLRPC {
626    my ($self, $c, $reqspec, @args) = @_;
627
628    $c->forward('qf', [ $reqspec, @args, '%{license}' ]);
629}
630
631=head2 l
632
633Is an alias to C<license> command.
634
635=cut 
636
637sub l : XMLRPC {
638    my ($self, $c, @args) = @_;
639    $c->forward('license', [ @args ]);
640}
641
642=head2 buildtime [-d distrib] [-r release] [-a arch] [-s] NAME
643
644Show the build time of package C<NAME>.
645
646=cut
647
648sub buildtime : XMLRPC {
649    my ($self, $c, $reqspec, @args) = @_;
650
651    $c->forward('qf', [ $reqspec, @args, '%{buildtime:date}' ]);
652}
653
654=head2 builddate
655
656Is an alias for C<buildtime> command.
657
658=cut
659
660sub builddate : XMLRPC {
661    my ($self, $c, @args) = @_;
662    $c->forward('buildtime', [ @args ]);
663}
664
665=head2 b
666
667Is an alias for C<buildtime> command.
668
669=cut
670
671sub b : XMLRPC {
672    my ($self, $c, @args) = @_;
673    $c->forward('builddate', [ @args ]);
674}
675
676=head2 cookie [-d distrib] [-r release] [-a arch] [-s]  NAME
677
678Show the C<cookie> tag of package C<NAME>.
679
680=cut
681
682sub cookie : XMLRPC {
683    my ($self, $c, $reqspec, @args) = @_;
684
685    $c->forward('qf', [ $reqspec, @args, '%{cookie}' ]);
686}
687
688=head2 sourcerpm [-d distrib] [-r release] [-a arch] [-s] NAME
689
690Show the C<sourcerpm> tag of package C<NAME>.
691
692=cut
693
694sub sourcerpm : XMLRPC {
695    my ($self, $c, $reqspec, @args) = @_;
696
697    $c->forward('qf', [ $reqspec, @args, '%{sourcerpm}' ]);
698}
699
700=head2 src NAME
701
702Is an alias for C<sourcerpm> command.
703
704=cut
705
706sub src : XMLRPC {
707    my ($self, $c, $reqspec, @args) = @_;
708
709    $c->forward('sourcerpm', [ $reqspec, @args ]);
710}
711
712=head2 rpmversion [-d distrib] [-r release] [-a arch] [-s] NAME
713
714Show the C<rpmversion> tag of package C<NAME>.
715
716=cut
717
718sub rpmversion : XMLRPC {
719    my ($self, $c, $reqspec, @args) = @_;
720
721    $c->forward('qf', [ $reqspec, @args, '%{rpmversion}' ]);
722}
723
724=head2 rpmbuildversion NAME
725
726Is an alias for C<rpmversion> command.
727
728=cut
729
730sub rpmbuildversion : XMLRPC {
731    my ($self, $c, $reqspec, @args) = @_;
732
733    $c->forward('rpmversion', [ $reqspec, @args ]);
734}
735
736
737=head2 buildhost [-d distrib] [-r release] [-a arch] [-s] NAME
738
739Show the C<buildhost> tag of package C<NAME>.
740
741=cut
742
743sub buildhost : XMLRPC {
744    my ($self, $c, $reqspec, @args) = @_;
745
746    $c->forward('qf', [ $reqspec, @args, '%{buildhost}' ]);
747}
748
749=head2 host NAME
750
751Is an alias for C<buildhost> command.
752
753=cut
754
755sub host : XMLRPC {
756    my ($self, $c, $reqspec, @args) = @_;
757
758    $c->forward('host', [ $reqspec, @args ]);
759}
760
761=head2 h NAME
762
763Is an alias for C<buildhost> command.
764
765=cut
766
767sub h : XMLRPC {
768    my ($self, $c, $reqspec, @args) = @_;
769
770    $c->forward('host', [ $reqspec, @args ]);
771}
772
773
774
775=head2 distribution [-d distrib] [-r release] [-a arch] [-s] NAME
776
777Show the C<distribution> tag of package C<NAME>.
778
779=cut
780
781sub distribution : XMLRPC {
782    my ($self, $c, $reqspec, @args) = @_;
783
784    $c->forward('qf', [ $reqspec, @args, '%{distribution}' ]);
785}
786
787=head2 distrib NAME
788
789Is an alias for C<distribution> command.
790
791=cut
792
793sub distrib : XMLRPC {
794    my ($self, $c, $reqspec, @args) = @_;
795
796    $c->forward('distribution', [ $reqspec, @args ]);
797}
798
799
800
801=head2 vendor [-d distrib] [-r release] [-a arch] [-s] NAME
802
803Show the C<vendor> tag of package C<NAME>.
804
805=cut
806
807sub vendor : XMLRPC {
808    my ($self, $c, $reqspec, @args) = @_;
809
810    $c->forward('qf', [ $reqspec, @args, '%{vendor}' ]);
811}
812
813=head2 qf [-d distrib] [-r release] [-a arch] [-s] NAME FMT
814
815Perform an rpm -q --qf C<FMT> on package C<NAME>.
816
817=cut
818
819sub qf : XMLRPC {
820    my ($self, $c, $reqspec, @args) = @_;
821    my @message;
822    $reqspec->{src} = 0;
823
824    @args = @{ $c->forward('_getopt', [
825        {
826            'd=s' => \$reqspec->{distribution},
827            'v=s' => \$reqspec->{release},
828            'r=s' => \$reqspec->{release},
829            'a=s' => \$reqspec->{arch},
830            's'   => sub { $reqspec->{src} = 1 },
831        }, @args ]) };
832
833    @args == 2 or do {
834        $c->error('No argument given');
835        return;
836    };
837
838    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
839        return $c->stash->{xmlrpc} = {
840            message => [ "I don't have such distribution : "
841                    .$c->forward('_fmt_question', [$reqspec])],
842        };
843    }
844
845    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
846    if (!@{ $rpmlist }) {
847        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
848        if ($else) {
849            return $c->stash->{xmlrpc} = {
850                message => [ 
851                    "There is no rpm named `$args[0]' in "
852                    .$c->forward('_fmt_question', [$reqspec])
853                    .", but the word matches in " . $else
854                ],
855            }
856        } else {
857            return $c->stash->{xmlrpc} = {
858                message => [ "The rpm named `$args[0]' has not been found in "
859                    .$c->forward('_fmt_question', [$reqspec])],
860            }
861        }
862    }
863    foreach (@{ $rpmlist }) {
864        my $info = $c->forward('/rpms/queryformat', [ $_, $args[1] ]);
865        push @message, $info . ' // ' .
866            $c->forward('_fmt_location', [ $reqspec, $_ ]);
867    }
868    return $c->stash->{xmlrpc} = {
869        message => \@message,
870    }
871}
872
873=head2 more [-d distrib] [-r release] [-a arch] [-s]  NAME
874
875Show url where details about package named C<NAME> can be found
876
877=cut
878
879sub more : XMLRPC {
880    my ($self, $c, $reqspec, @args) = @_;
881    my @message;
882    $reqspec->{src} = 0;
883
884    @args = @{ $c->forward('_getopt', [
885        {
886            'd=s' => \$reqspec->{distribution},
887            'v=s' => \$reqspec->{release},
888            'r=s' => \$reqspec->{release},
889            'a=s' => \$reqspec->{arch},
890            's'   => sub { $reqspec->{src} = 1 },
891        }, @args ]) };
892
893    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
894        return $c->stash->{xmlrpc} = {
895            message => [ "I don't have such distribution : "
896                    .$c->forward('_fmt_question', [$reqspec])],
897        };
898    }
899
900    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
901    if (!@{ $rpmlist }) {
902        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
903        if ($else) {
904            return $c->stash->{xmlrpc} = {
905                message => [ 
906                    "There is no rpm named `$args[0]' in "
907                    .$c->forward('_fmt_question', [$reqspec])
908                    .", but the word matches in " . $else
909                ],
910            }
911        } else {
912            return $c->stash->{xmlrpc} = {
913                message => [ "The rpm named `$args[0]' has not been found in "
914                    .$c->forward('_fmt_question', [$reqspec])],
915            }
916        }
917    }
918    foreach (@{ $rpmlist }) {
919        push @message, $c->uri_for('/rpms', $_) . ' // ' .
920            $c->forward('_fmt_location', [ $reqspec, $_ ]);
921    }
922    return $c->stash->{xmlrpc} = {
923        message => \@message,
924    }
925}
926
927=head2 buildfrom [-d distrib] [-r release] [-a arch] NAME
928
929Return the list of package build from source package named C<NAME>
930
931=cut
932
933sub buildfrom : XMLRPC {
934    my ($self, $c, $reqspec, @args) = @_;
935    $reqspec->{src} = 1;
936    my @message;
937    @args = @{ $c->forward('_getopt', [
938        {
939            'd=s' => \$reqspec->{distribution},
940            'v=s' => \$reqspec->{release},
941            'r=s' => \$reqspec->{release},
942            'a=s' => \$reqspec->{arch},
943        }, @args ]) };
944    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
945        return $c->stash->{xmlrpc} = {
946            message => [ "I don't have such distribution in "
947                    .$c->forward('_fmt_question', [$reqspec])],
948        };
949    }
950    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
951    if (!@{ $rpmlist }) {
952        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
953        if ($else) {
954            return $c->stash->{xmlrpc} = {
955                message => [ 
956                    "There is no rpm named `$args[0]' in "
957                    .$c->forward('_fmt_question', [$reqspec])
958                    .", but the word matches in " . $else
959                ],
960            }
961        } else {
962            return $c->stash->{xmlrpc} = {
963                message => [ "The rpm named `$args[0]' has not been found in "
964                    .$c->forward('_fmt_question', [$reqspec])],
965            }
966        }
967    }
968    foreach (@{ $rpmlist }) {
969        my $res = $c->forward('/rpms/binaries', [ $_ ]);
970        my @name;
971        foreach (@$res) {
972            push(@name, $c->forward('/rpms/basicinfo', [ $_ ])->{name});
973        }
974        push(@message, join(', ', sort @name));
975    }
976    return $c->stash->{xmlrpc} = {
977        message => \@message,
978    }
979
980}
981
982=head2 findfile [-d distrib] [-r release] [-a arch] [-s] FILE
983
984Return the rpm owning the file C<FILE>.
985
986=cut
987
988sub findfile : XMLRPC {
989    my ($self, $c, $reqspec, @args) = @_;
990
991    my @message;
992    $reqspec->{src} = 0;
993
994    @args = @{ $c->forward('_getopt', [
995        {
996            'd=s' => \$reqspec->{distribution},
997            'v=s' => \$reqspec->{release},
998            'r=s' => \$reqspec->{release},
999            'a=s' => \$reqspec->{arch},
1000            's'   => \$reqspec->{src},
1001        }, @args ]) };
1002
1003    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
1004        return $c->stash->{xmlrpc} = {
1005            message => [ "I don't have such distribution in "
1006                    .$c->forward('_fmt_question', [$reqspec])],
1007        };
1008    }
1009
1010    my $rpmlist = $c->forward('/search/rpm/byfile', [ $reqspec, $args[0] ]);
1011    if (!@{ $rpmlist }) {
1012        return $c->stash->{xmlrpc} = {
1013            message => [ "Sorry, no file $args[0] found in "
1014                    .$c->forward('_fmt_question', [$reqspec])],
1015        }
1016    } elsif (@{ $rpmlist } > 20) {
1017        foreach (@{ $rpmlist }) {
1018            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
1019            push @message, $info->{name} . ' // ' .
1020                $c->forward('_fmt_location', [ $reqspec, $_ ]);
1021        }
1022        return $c->stash->{xmlrpc} = {
1023            message => ["find in "
1024                    .$c->forward('_fmt_question', [$reqspec])
1025                    ." :",
1026                    @message],
1027        }
1028    } else {
1029        my %list;
1030        foreach (@{ $rpmlist }) {
1031            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
1032            $list{$info->{name}} = 1;
1033        }
1034        return $c->stash->{xmlrpc} = {
1035            message => ["find in "
1036                    .$c->forward('_fmt_question', [$reqspec])
1037                    ." : ".join(', ', sort keys %list) ],
1038        };
1039    }
1040}
1041
1042=head2 what [-d distrib] [-r release] [-a arch] [-s] p|r|c|o|e|s DEP [SENSE [EVR]]
1043
1044Search rpm matching having matching dependencies (provides, requires, conflicts,
1045obsoletes, enhanced or suggests)
1046
1047=cut
1048
1049sub what : XMLRPC {
1050    my ($self, $c, $reqspec, @args) = @_;
1051       
1052    @args = @{ $c->forward('_getopt', [
1053        {
1054            'd=s' => \$reqspec->{distribution},
1055            'v=s' => \$reqspec->{release},
1056            'r=s' => \$reqspec->{release},
1057            'a=s' => \$reqspec->{arch},
1058            's'   => \$reqspec->{src},
1059        }, @args ]) };
1060
1061    my ($type, $depname, $sense, $evr) = @args;
1062
1063    my $deptype = uc(substr($type, 0, 1));
1064    my $rpmlist = $c->forward('/search/rpm/bydep',
1065        [ $reqspec, $deptype, $depname, $sense, $evr ]);
1066
1067    if (@{ $rpmlist } < 20) {
1068        my @name;
1069        foreach (@{ $rpmlist }) {
1070            my $info = $c->forward('/rpms/basicinfo', [ $_ ]);
1071            push @name, $info->{name} . '-' . $info->{evr};
1072        }
1073        return $c->stash->{xmlrpc} = {
1074            message => [
1075                "Package matching $depname" . ($evr ? " $sense $evr" : '') .
1076                " in "
1077                .$c->forward('_fmt_question', [$reqspec])
1078                .':', 
1079                join(' ', @name),
1080            ],
1081        }
1082    } else {
1083        return $c->stash->{xmlrpc} = {
1084            message => [ 'Too many results in ' 
1085                    .$c->forward('_fmt_question', [$reqspec])],
1086        };
1087    }
1088
1089}
1090
1091=head2 maint [-d distrib] [-r release] [-a arch] [-s] RPMNAME
1092
1093Show the maintainers for the rpm named C<RPMNAME>.
1094
1095=cut
1096
1097sub maint : XMLRPC {
1098    my ($self, $c, $reqspec, @args) = @_;
1099    $reqspec->{src} = 0;
1100    my @message;
1101    @args = @{ $c->forward('_getopt', [
1102        {
1103            'd=s' => \$reqspec->{distribution},
1104            'v=s' => \$reqspec->{release},
1105            'r=s' => \$reqspec->{release},
1106            'a=s' => \$reqspec->{arch},
1107            's'   => \$reqspec->{src},
1108        }, @args ]) };
1109    if (!$c->forward('/distrib/exists', [ $reqspec ])) {
1110        return $c->stash->{xmlrpc} = {
1111            message => [ "I don't have such distribution : " 
1112                    .$c->forward('_fmt_question', [$reqspec])],
1113        };
1114    }
1115    my $rpmlist = $c->forward('/search/rpm/byname', [ $reqspec, $args[0] ]);
1116    if (!@{ $rpmlist }) {
1117        my $else = $c->forward('_find_rpm_elsewhere', [ $reqspec, $args[0] ]);
1118        if ($else) {
1119            return $c->stash->{xmlrpc} = {
1120                message => [ 
1121                    "There is no rpm named `$args[0]' in "
1122                    .$c->forward('_fmt_question', [$reqspec])
1123                    .", but the word matches in " . $else
1124                ],
1125            }
1126        } else {
1127            return $c->stash->{xmlrpc} = {
1128                message => [ "The rpm named `$args[0]' has not been found in "
1129                    .$c->forward('_fmt_question', [$reqspec])],
1130            }
1131        }
1132    }
1133    my %maint;
1134    foreach (@{ $rpmlist }) {
1135        my $res = $c->forward('/rpms/maintainers', [ $_ ]);
1136        foreach (@$res) {
1137            my $m = 'For ' . $_->{vendor} . ': ' . $_->{owner};
1138            $maint{$m} = 1;
1139        }
1140    }
1141    return $c->stash->{xmlrpc} = {
1142        message => [ sort keys %maint ],
1143    }
1144}
1145
1146=head2 nb_rpm [-d distrib] NAME
1147
1148Show the count of rpm maintains by packager matching C<NAME>.
1149
1150=cut
1151
1152sub nb_rpm : XMLRPC {
1153    my ($self, $c, $reqspec, @args) = @_;
1154    my @message;
1155    my $dist = { distribution => $reqspec->{distribution} };
1156    @args = @{ $c->forward('_getopt', [
1157        {
1158            'd=s' => \$dist->{distribution},
1159        }, @args ]) };
1160    if (!$c->forward('/distrib/exists', [ $dist ])) {
1161        return $c->stash->{xmlrpc} = {
1162            message => [ "I don't have such distribution : "
1163                    .$c->forward('_fmt_question', [$reqspec])],
1164        };
1165    }
1166
1167    my $maints = $c->forward('/maintainers/search',
1168        [ $args[0], $dist->{distribution} ]);
1169    if (@$maints > 3) {
1170        return $c->stash->{xmlrpc} = {
1171            message => [ 
1172                scalar(@$maints) . " maintainers found matching `$args[0]' in "
1173                    .$c->forward('_fmt_question', [$reqspec])],
1174        };
1175    } elsif (! @$maints) {
1176        return $c->stash->{xmlrpc} = {
1177            message => [ "No maintainer found matching `$args[0]' in " 
1178                    .$c->forward('_fmt_question', [$reqspec])],
1179        };
1180    } else {
1181        my @messages;
1182        foreach (@$maints) {
1183            my $rpms = $c->forward('/maintainers/bymaintainer', [
1184                $_->{owner}, $dist->{distribution} ]);
1185            push(@messages, sprintf('%s (%s) maintains %d rpms',
1186                    $_->{owner},
1187                    $_->{vendor},
1188                    scalar(@$rpms),
1189                )
1190            );
1191        }
1192        return $c->stash->{xmlrpc} = {
1193            message => \@messages,
1194        };
1195    }
1196}
1197
1198=head1 AUTHOR
1199
1200Olivier Thauvin
1201
1202=head1 LICENSE
1203
1204This library is free software. You can redistribute it and/or modify
1205it under the same terms as Perl itself.
1206
1207=cut
1208
1209__PACKAGE__->meta->make_immutable;
1210
12111;
Note: See TracBrowser for help on using the repository browser.