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

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