source: server/trunk/web/lib/Sophie/Controller/Rpms.pm @ 355

Last change on this file since 355 was 355, checked in by nanardon, 13 years ago
  • don't return header itself as information
File size: 19.6 KB
Line 
1package Sophie::Controller::Rpms;
2use Moose;
3use namespace::autoclean;
4use Encode::Guess;
5use Encode;
6use POSIX;
7
8BEGIN {extends 'Catalyst::Controller'; }
9
10=head1 NAME
11
12Sophie::Controller::Rpms - Catalyst Controller
13
14=head1 DESCRIPTION
15
16Catalyst Controller.
17
18=head1 METHODS
19
20=cut
21
22
23=head2 index
24
25=cut
26
27sub index :Path :Args(0) {
28    my ( $self, $c ) = @_;
29
30    $c->response->redirect('/');
31}
32
33=head2 rpms.queryformat( PKGID, FORMAT )
34
35Perform an C<rpm -q --qf> on the package having C<PKGID>.
36
37=cut
38
39sub queryformat : XMLRPCLocal {
40    my ( $self, $c, $pkgid, $qf ) = @_;
41    $c->stash->{xmlrpc} = $c->model('base')->resultset('Rpms')->search(
42        { pkgid => $pkgid },
43        { 
44            select => [ qq{rpmqueryformat("header", ?)} ],
45            as => [ 'qf' ],
46            bind => [ $qf ],
47        }
48    )->next->get_column('qf');
49}
50
51=head2 rpms.tag( PKGID, TAG )
52
53Return the list of C<TAG> values for package C<PKGID>
54
55=cut
56
57sub tag : XMLRPCLocal {
58    my ( $self, $c, $pkgid, $tag ) = @_;
59    $c->stash->{xmlrpc} = [ map { $_->get_column('tag') } $c->model('Base')->resultset('Rpms')->search(
60        { pkgid => $pkgid },
61        { 
62            select => [ qq{rpmquery("header", rpmtag(?))} ],
63            as => [ 'tag' ],
64            bind => [ $tag ], 
65        }
66    )->all ]
67}
68
69=head2 rpms.basicinfo( PKGID )
70
71Return a struct about basic informations about rpm having pkgid C<PKGID>.
72
73Example of information return:
74
75    {
76          'arch' => 'x86_64',
77          'version' => '0.0.3',
78          'src' => '1',
79          'issrc' => '1',
80          'name' => 'ecap-samples',
81          'release' => '1mdv2010.2',
82          'description' => 'The sample contains three basic adapters.',
83          'pkgid' => 'aa17ce95dd816e0817da78d7af54abdb',
84          'summary' => 'Simple ecap samples',
85          'filename' => 'ecap-samples-0.0.3-1mdv2010.2.src.rpm',
86          'evr' => '0.0.3-1mdv2010.2'
87    };
88
89=head2 Url: /rpms/<PKGID>/basicinfo?json
90
91Return a struct about basic informations about rpm having pkgid C<PKGID>.
92
93Example of information return:
94
95    {
96          'arch' => 'x86_64',
97          'version' => '0.0.3',
98          'src' => '1',
99          'issrc' => '1',
100          'name' => 'ecap-samples',
101          'release' => '1mdv2010.2',
102          'description' => 'The sample contains three basic adapters.',
103          'pkgid' => 'aa17ce95dd816e0817da78d7af54abdb',
104          'summary' => 'Simple ecap samples',
105          'filename' => 'ecap-samples-0.0.3-1mdv2010.2.src.rpm',
106          'evr' => '0.0.3-1mdv2010.2'
107    };
108
109NB: This url works only in JSON format.
110
111=cut
112
113sub basicinfo :XMLRPCLocal :Chained('rpms_') :PathPart('basicinfo') :Args(0) {
114    my ($self, $c, $pkgid) = @_;
115    $pkgid ||= $c->stash->{pkgid};
116
117    my $rpm = $c->model('base::Rpms')->find(
118        { pkgid => $pkgid },
119        { 'select' => [ qw(pkgid summary description issrc name evr arch) ],
120          'as'     => [ qw(pkgid summary description issrc name evr arch) ], }
121    );
122    $rpm or return;
123    my %info = $rpm->get_columns;
124    $info{src} = $info{issrc} ? 1 : 0;
125    foreach (qw(version release arch)) {
126        if (my $r = $c->model('base')->resultset('Rpms')->search(
127            { pkgid => $pkgid },
128            { 
129                select => [ qq{rpmquery("header", ?)} ],
130                as => [ 'qf' ],
131                bind => [ $_ ],
132            }
133            )->next) { 
134            $info{$_} = $r->get_column('qf');
135        }
136    }
137    $info{filename} = $c->forward('queryformat',
138        [ $pkgid,
139            '%{NAME}-%{VERSION}-%{RELEASE}.%|SOURCERPM?{%{ARCH}}:{src}|.rpm'
140        ]);
141
142    return $c->stash->{xmlrpc} = \%info;
143}
144
145=head2 rpms.info( PKGID )
146
147Like rpms.basicinfo return a struct containing single information about the request rpm.
148
149=head2 Url: /rpms/<PKGID>/info?json
150
151Like rpms/<PKGID>basicinfo return a struct containing single information about the request rpm.
152
153NB: This url works only in JSON format.
154
155=cut
156
157sub info : XMLRPCLocal :Chained('rpms_') :PathPart('info') :Args(0) {
158    my ($self, $c, $pkgid) = @_;
159    $pkgid ||= $c->stash->{pkgid};
160
161    my $info = $c->forward('basicinfo', [ $pkgid ]);
162    foreach (qw(name epoch url group size packager
163                url sourcerpm license buildhost
164                distribution)) {
165        if (my $r = $c->model('base')->resultset('Rpms')->search(
166            { pkgid => $pkgid },
167            { 
168                select => [ qq{rpmquery("header", ?)} ],
169                as => [ 'qf' ],
170                bind => [ $_ ],
171            }
172            )->next) { 
173            $info->{$_} = $r->get_column('qf');
174        }
175    }
176
177    return $c->stash->{xmlrpc} = $info;
178}
179
180=head2 rpms.dependency(PKGID, DEPTYPE)
181
182Return a list of C<DEPTYPE> dependencies for package C<PKGID> where C<DEPTYPE>
183is one of:
184
185=over 4
186
187=item C<P> for Provides
188
189=item C<R> for Requires
190
191=item C<C> for Conflicts
192
193=item C<O> for Obsoletes
194
195=item C<E> for Enhanced
196
197=item C<S> for Suggests
198
199=back
200
201=cut
202
203sub xmlrpc_dependency : XMLRPCPath('dependency') {
204    my ($self, $c, @args) = @_;
205    $c->forward('dependency', [ @args ]);
206}
207
208=head2 Url: /rpms/<PKGID>/dependency/<DEPTYPE>?json
209
210Return a list of C<DEPTYPE> dependencies for package C<PKGID> where C<DEPTYPE>
211is one of:
212
213=over 4
214
215=item C<P> for Provides
216
217=item C<R> for Requires
218
219=item C<C> for Conflicts
220
221=item C<O> for Obsoletes
222
223=item C<E> for Enhanced
224
225=item C<S> for Suggests
226
227=back
228
229=cut
230
231sub dependency :XMLRPC :Chained('rpms_') :PathPart('dependency') :Args(1) {
232    my ($self, $c, $pkgid, $deptype) = @_;
233    if (!$deptype) {
234        $deptype = $pkgid;
235        $pkgid = $c->stash->{pkgid};
236    }
237
238    $c->stash->{xmlrpc} = [ 
239        map { 
240            { 
241                name => $_->get_column('depname'),
242                flags => $_->get_column('flags'),
243                evr => $_->get_column('evr'),
244                sense => $_->get_column('sense'),
245            }
246        } 
247        $c->model('Base')->resultset('Deps')->search(
248            { 
249                pkgid => $pkgid,
250                deptype => $deptype,
251            },
252            { 
253                order_by => [ 'count' ],
254                select => [ 'rpmsenseflag("flags")', qw(depname flags evr) ],
255                as => [ qw'sense depname flags evr' ],
256
257            },
258        )->all ];
259}
260
261sub sources : XMLRPCLocal {
262    my ( $self, $c, $pkgid ) = @_;
263
264    my $sourcerpm = $c->forward('queryformat', [ $pkgid, '%{SOURCERPM}' ]);
265    my $nosourcerpm = $sourcerpm;
266    $nosourcerpm =~ s/\.src.rpm$/\.nosrc.rpm/;
267
268    $c->stash->{xmlrpc} = [ $c->model('Base::Rpms')->search(
269        {
270            pkgid => { 
271                IN => $c->model('Base::RpmFile')->search(
272                    { filename => [ $sourcerpm, $nosourcerpm ] }
273                )->get_column('pkgid')->as_query
274            },
275        }
276    )->get_column('pkgid')->all ];
277}
278
279sub binaries : XMLRPCLocal {
280    my ( $self, $c, $pkgid ) = @_;
281
282    my $sourcerpm = $c->forward('queryformat', [ $pkgid,
283            '%{NAME}-%{VERSION}-%{RELEASE}.src.rpm' ]);
284    my $nosourcerpm = $sourcerpm;
285    $nosourcerpm =~ s/\.src.rpm$/\.nosrc.rpm/;
286
287    my $tagrs = $c->model('Base')->resultset('Tags')
288        ->search({ tagname => 'sourcerpm', value => [ $sourcerpm, $nosourcerpm ] })
289        ->get_column('pkgid');
290    $c->stash->{xmlrpc} = [ $c->model('Base::Rpms')->search(
291        {
292            -and => [
293                { issrc => 0 },
294                { pkgid =>
295                    { IN => $tagrs->as_query, },
296                },
297            ]
298        },
299        {
300            order_by => [ qw(arch name), 'evr using >>' ],
301        },
302    )->get_column('pkgid')->all ];
303
304}
305
306
307=head2 rpms.maintainers( PKGID )
308
309Return the maintainers for this package.
310
311The list of maintainers is limited to distribution where the package is located.
312
313If the package is a binary the C<SOURCERPM> tag is used to find the source rpm
314name.
315
316=cut
317
318sub maintainers : XMLRPCLocal {
319    my ($self, $c, $pkgid) = @_;
320
321    my $binfo = $c->forward('/rpms/basicinfo', [ $pkgid ]);
322    my $rpmname;
323    if ($binfo->{issrc}) {
324        $rpmname = $binfo->{name};
325    } else {
326        my $sourcerpm = $c->forward('queryformat', [ $pkgid, '%{SOURCERPM}' ]);
327        $sourcerpm =~ /^(.*)-([^-]+)-([^-]+)\.[^\.]+.rpm$/;
328        $rpmname = $1;
329    }
330    my %dist;
331    foreach (@{ $c->forward('/rpms/location', [ $pkgid ]) }) {
332        $dist{$_->{distribution}} = 1;
333    }
334
335    $c->forward('/maintainers/byrpm', [ $rpmname, [ keys %dist ] ]);
336}
337
338sub rpms_ :PathPrefix :Chained :CaptureArgs(1) {
339    my ( $self, $c, $pkgid ) = @_;
340    $c->stash->{pkgid} = $pkgid if($pkgid);
341    {
342        my $match = $c->stash->{pkgid};
343    }
344    if (!$c->model('Base::Rpms')->find({ pkgid => $c->stash->{pkgid} })) {
345        $c->go('/404/index');
346    }
347    my $info = $c->stash->{rpms}{info} =
348        $c->forward('info', [ $c->stash->{pkgid} ]);
349
350    $c->stash->{metatitle} = sprintf("%s-%s %s",
351        $info->{name},
352        $info->{evr},
353        $info->{issrc} ? 'src' : $info->{arch},
354    );
355    push(@{ $c->stash->{keywords} }, $info->{name}, $info->{evr},
356        $info->{issrc} ? 'src' : $info->{arch},);
357    $c->stash->{metarevisit} = 30;
358
359    # for later usage, keep history of visited rpms
360    $c->session->{visited_rpms}{$c->stash->{pkgid}} = time;
361    if (keys %{ $c->session->{visited_rpms} } > 20) {
362        my @visited = sort
363        { $c->session->{visited_rpms}{$b} <=> $c->session->{visited_rpms}{$a} }
364        keys %{ $c->session->{visited_rpms} };
365        splice(@visited, 0, 20);
366        delete $c->session->{visited_rpms}{$_} foreach (@visited);
367    }
368
369    $c->stash->{rpms}{location} =
370        $c->forward('location', [ $c->stash->{pkgid} ]);
371}
372
373sub rpms : Private {
374    my ( $self, $c, $pkgid, $subpart, @args) = @_;
375    # Because $c->forward don't take into account Chained sub
376    $c->forward('rpms_', [ $pkgid ]);
377    for ($subpart || '') {
378        /^deps$/       and $c->go('deps',        [ $pkgid, @args ]);
379        /^files$/      and $c->go('files',       [ $pkgid, @args ]);
380        /^changelog$/  and $c->go('changelog',   [ $pkgid, @args ]);
381        /^location$/   and $c->go('location',    [ $pkgid, @args ]);
382        /^basicinfo$/  and $c->go('basicinfo',   [ $pkgid, @args ]);
383        /^info$/       and $c->go('info',        [ $pkgid, @args ]);
384        /^analyse$/    and $c->go('analyse',     [ $pkgid, @args ]);
385        /^dependency$/ and $c->go('dependency',  [ $pkgid, @args ]);
386        /^history$/    and $c->go('history',     [ $pkgid, @args ]);
387        /^query$/      and $c->go('query',       [ $pkgid, @args ]);
388        /^scriptlet$/  and $c->go('scriptlet',   [ $pkgid, @args ]);
389        /./            and $c->go('/404/index'); # other subpart dont exists
390    }
391    $c->stash->{rpmurl} = $c->req->path;
392
393    return $c->stash->{xmlrpc} = $c->stash->{rpms};
394}
395
396sub rpms__ : Chained('/rpms/rpms_') :PathPart('') :Args(0) {
397    my ( $self, $c ) = @_;
398
399    $c->go('rpms', [ $c->stash->{pkgid} ]);
400}
401
402
403sub deps :Chained('rpms_') :PathPart('deps') :Args(0) :XMLRPCLocal {
404    my ( $self, $c, $pkgid ) = @_;
405    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
406    $pkgid ||= $c->stash->{pkgid};
407
408    my %deps;
409    foreach (
410        $c->model('Base')->resultset('Deps')->search(
411            { 
412                pkgid => $pkgid,
413            },
414            { 
415                order_by => [ 'count' ],
416                select => [ 'rpmsenseflag("flags")',
417                    qw(depname flags evr deptype) ],
418                as => [ qw'sense depname flags evr deptype' ],
419
420            },
421        )->all) {
422        push( @{ $deps{$_->get_column('deptype')} },
423            {
424                name => $_->get_column('depname'),
425                flags => $_->get_column('flags'),
426                evr => $_->get_column('evr'),
427                sense => $_->get_column('sense'),
428            }
429        );
430    }
431    $c->stash->{xmlrpc} = \%deps;
432}
433
434sub files :Chained('rpms_') :PathPart('files') :Args(0) :XMLRPCLocal {
435    my ( $self, $c, $pkgid, $number ) = @_;
436    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
437    $pkgid ||= $c->stash->{pkgid};
438
439    if ($number) { # This come from a forward
440        $c->go('files_contents', [ $number ]);
441    }
442
443    my @col = qw(dirname basename md5 size count);
444    $c->stash->{xmlrpc} = [ map {
445        {
446            filename => $_->get_column('dirname') . $_->get_column('basename'),
447            dirname => $_->get_column('dirname'),
448            basename => $_->get_column('basename'),
449            md5 => $_->get_column('md5'),
450            perm => $_->get_column('perm'),
451            size => $_->get_column('size'),
452            user => $_->get_column('user'),
453            group => $_->get_column('group'),
454            has_content => $_->get_column('has_content'),
455            count => $_->get_column('count'),
456        }
457    } $c->model('Base')->resultset('Files')->search(
458            { 
459                pkgid => $pkgid,
460            },
461            { 
462                'select' => [ 'contents is NOT NULL as has_content', 'rpmfilesmode(mode) as perm', @col, '"group"',
463                    '"user"' ],
464                as => [ qw(has_content perm), @col, 'group', 'user' ],
465                order_by => [ 'dirname', 'basename' ],
466
467            },
468        )->all ];
469}
470
471sub files_contents :Chained('rpms_') :PathPart('files') :Args(1) {
472    my ( $self, $c, $number ) = @_;
473    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+/[^/]+:)[0];
474    my $pkgid = $c->stash->{pkgid};
475
476    $c->stash->{xmlrpc} = $c->model('Base::Files')->search(
477        {
478            pkgid => $pkgid,
479            count => $number,
480        },
481        {
482            select => ['contents'],
483        }
484    )->get_column('contents')->first;
485}
486
487sub changelog :Chained('rpms_') :PathPart('changelog') :Args(0) :XMLRPCLocal {
488    my ( $self, $c, $pkgid ) = @_;
489    $pkgid ||= $c->stash->{pkgid};
490    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
491
492    my @ch;
493    foreach ($c->model('Base')->resultset('RpmsChangelog')->search({},
494            { 
495                bind => [ $pkgid ],
496                order_by => [ 'time::int desc' ],
497            },
498        )->all) {
499        my $chentry;
500        my $enc = guess_encoding($_->get_column('text'), qw/latin1/);
501        $chentry->{text} = $enc && ref $enc
502            ? encode('utf8', $_->get_column('text'))
503            : $_->get_column('text');
504        $enc = guess_encoding($_->get_column('name'), qw/latin1/);
505        $chentry->{name} = $enc && ref $enc
506            ? encode('utf8', $_->get_column('name'))
507            : $_->get_column('name');
508        $chentry->{time} = $_->get_column('time');
509        $chentry->{date} = POSIX::strftime('%a %b %e %Y', gmtime($_->get_column('time')));
510        push(@ch, $chentry);
511    }
512
513    $c->stash->{xmlrpc} = \@ch;
514}
515
516sub scriptlet :Chained('rpms_') :PathPart('scriptlet') :Args(0) :XMLRPCLocal {
517    my ( $self, $c, $pkgid ) = @_;
518    $pkgid ||= $c->stash->{pkgid};
519    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
520
521    $c->stash->{xmlrpc} = {};
522    foreach (
523            [ 'PREIN', 'PREINPROG' ],
524            [ 'POSTIN', 'POSTINPROG' ],
525            [ 'PREUN', 'PREUNPROG' ],
526            [ 'POSTUN', 'POSTUNPROG' ],
527            [ 'PRETRANS', 'PRETRANSPROG' ],
528            [ 'POSTTRANS', 'POSTTRANSPROG' ],
529        ) {
530           
531        my ($res) = $c->model('Base::Rpms')->search(
532            { pkgid => $pkgid },
533            { 
534                select => [ 
535                    qq{rpmquery("header", ?)},
536                    qq{rpmquery("header", ?)},
537                ],
538                as => [ qw(script prog) ],
539                bind => $_,
540            }
541        )->all;
542       
543        $c->stash->{xmlrpc}{$_->[0]} = { $res->get_columns } if ($res);
544    }
545    $c->stash->{xmlrpc}{triggers} = [
546        map { { $_->get_columns } }
547        $c->model('Base::Rpms')->search(
548            { pkgid => $pkgid },
549            { 
550                select => [ 
551                    qq{rpmquery("header", ?)},
552                    qq{rpmquery("header", ?)},
553                    qq{rpmquery("header", ?)},
554                    qq{rpmsenseflag(rpmquery("header", ?)::int)},
555                    qq{rpmquery("header", ?)},
556                ],
557                as => [ qw(script prog name sense version) ],
558                bind => [qw(
559                    TRIGGERSCRIPTS
560                    TRIGGERSCRIPTPROG
561                    TRIGGERNAME
562                    TRIGGERFLAGS
563                    TRIGGERVERSION
564                    )]
565            }
566        )->all ];
567
568    return $c->stash->{xmlrpc};
569}
570
571=head2 rpms.location( PKGID )
572
573Return all distribution where the package having C<PKGID> can be found.
574
575=cut
576
577sub location :Chained('rpms_') :PathPart('location') :Args(0) {
578    my ( $self, $c, $pkgid ) = @_;
579    $pkgid ||= $c->stash->{pkgid};
580    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
581
582    $c->stash->{xmlrpc} = [
583        map {
584        {
585            distribution => $_->get_column('name'),
586            dist => $_->get_column('shortname'),
587            release => $_->get_column('version'),
588            arch => $_->get_column('arch'), 
589            media => $_->get_column('label'),
590            media_group => $_->get_column('group_label'),
591        }
592        }
593        $c->forward('/distrib/distrib_rs', [ {} ])
594         ->search_related('MediasPaths')
595                 ->search_related('Paths')
596        ->search_related('Rpmfiles',
597            { pkgid => $pkgid },
598            {
599                select => [ qw(shortname name version arch label group_label) ],
600                order_by => [ qw(name version arch label) ],
601            }
602        )->all ]
603}
604
605sub analyse :Chained('rpms_') :PathPart('analyse') :Args(0) :XMLRPC {
606    my ( $self, $c, $pkgid, $dist ) = @_;
607    $pkgid ||= $c->stash->{pkgid};
608    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
609    if ($c->req->param('start')) {
610        $dist->{distribution} = $c->req->param('distribution');
611        $dist->{release} = $c->req->param('release');
612        $dist->{arch} = $c->req->param('arch');
613        $c->session->{analyse} = $dist;
614    } elsif (! $c->req->xmlrpc->is_xmlrpc_request) {
615        $dist ||= $c->forward('/user/prefs/get_default_distrib');
616        foreach (qw(distribution release arch)) {
617            $c->req->params->{$_} = $dist ? $dist->{$_} : undef;
618        }
619    }
620
621    if ($c->req->param('analyse')) {
622        $dist = $c->session->{analyse};
623    }
624
625    if ($c->req->param('analyse') || $c->req->xmlrpc->is_xmlrpc_request) {
626
627        my @deplist = map {
628            [ $_->{name}, $_->{sense}, $_->{evr} ]
629        } @{ $c->forward('dependency', [ $pkgid, 'R' ]) };
630
631        return $c->stash->{xmlrpc} = $c->forward(
632            '/analysis/solver/solve_dependencies',
633            [ $dist,
634                'P', \@deplist, [] ]
635        );
636    } else {
637        $c->stash->{xmlrpc} = '';
638    }
639}
640
641sub history :Chained('rpms_') :PathPart('history') :Args(0) :XMLRPC {
642    my ( $self, $c, $pkgid, $dist ) = @_;
643    $pkgid ||= $c->stash->{pkgid};
644    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
645
646    my $highter = $c->forward('/search/rpm/byname', [
647            { rows => 5, src => $c->stash->{rpms}{info}{issrc} },
648            $c->stash->{rpms}{info}{name}, '>', $c->stash->{rpms}{info}{version} ]);
649    my $lesser = $c->forward('/search/rpm/byname', [
650            { rows => 5, src => $c->stash->{rpms}{info}{issrc} },
651            $c->stash->{rpms}{info}{name}, '<', $c->stash->{rpms}{info}{version} ]);
652    $c->stash->{xmlrpc} = {
653        highter => $highter,
654        older => $lesser,
655    };
656}
657
658# compat URL:
659sub query :Chained('rpms_') :PathPart('analyse') :Args(0) {
660    my ( $self, $c, $pkgid, $dist ) = @_;
661    $pkgid ||= $c->stash->{pkgid};
662    $c->stash->{rpmurl} = ($c->req->path =~ m:(.*)/[^/]+:)[0];
663    $c->res->redirect($c->uri_for('/', $c->stash->{rpmurl}, 'analyse'));
664}
665
666=head1 AUTHOR
667
668Olivier Thauvin
669
670=head1 LICENSE
671
672This library is free software. You can redistribute it and/or modify
673it under the same terms as Perl itself.
674
675=cut
676
677__PACKAGE__->meta->make_immutable;
678
6791;
Note: See TracBrowser for help on using the repository browser.