Group
Extension

Module-CPANTS-Site/lib/Module/CPANTS/Site/Controller/Dist.pm

package Module::CPANTS::Site::Controller::Dist;

use strict;
use warnings;

use base qw( Catalyst::Controller::BindLex );

sub search : Local {
    my ( $self, $c, $search ) = @_;
    my $term : Stashed = $search || $c->req->param( 'dist' );

    return unless $term;

    $c->log->debug( "search dist for $term" ) if $c->debug;
    $term=~s/::/-/g;
        
    my $list : Stashed = $c->model( 'DBIC::Dist' )->search(
        {
            dist => { ILIKE =>  '%' . $term . '%' },
        },
        {
            order_by => 'dist ASC',
            page     => $c->request->param( 'page' ) || 1,
            rows     => 20,
        }
    );
    if ($list == 1) {
        $c->response->redirect($c->uri_for('/dist/overview',$list->first->dist));
    }
}

# for backward compat / google

sub view : Path {
    my ( $self, $c, $distname ) = @_;
    $c->res->redirect($c->uri_for('overview',$distname));
}   

sub overview : Local {
    my ( $self, $c, $distname ) = @_;
    $c->forward('get_dist',[ $distname ]);
}

sub kwalitee : Local {
    my ( $self, $c, $distname ) = @_;
    $c->forward('get_dist',[ $distname ]);
    my $kwalitee_hash : Stashed = $c->model( 'Kwalitee' )->get_indicators_hash;
}

sub prereq : Local {
    my ( $self, $c, $distname ) = @_;
    my $dist = $c->forward('get_dist',[ $distname ]);
    $c->stash->{ prereqs } = $dist->get_prereqs();
    $c->stash->{ build_prereqs } = $dist->get_build_prereqs();
    $c->stash->{ optional_prereqs } = $dist->get_optional_prereqs();
}

sub used_by : Local {
    my ( $self, $c, $distname ) = @_;
    my $dist = $c->forward('get_dist',[ $distname ]);
    $c->stash->{ used_by } = $dist->used_by;
}

sub metadata : Local {
    my ( $self, $c, $distname ) = @_;
    $c->forward('get_dist',[ $distname ]);
}

sub provides : Local {
    my ( $self, $c, $distname ) = @_;
    $c->forward('get_dist',[ $distname ]);
}

sub errors : Local {
    my ( $self, $c, $distname ) = @_;
    $c->forward('get_dist',[ $distname ]);
}

sub external : Local {
    my ( $self, $c, $distname ) = @_;
    $c->forward('get_dist',[ $distname ]);
}

sub get_dist : Private {
    my ( $self, $c, $distname ) = @_;

    unless( $distname ) {
        $c->stash->{ template } = 'dist/search';
        $c->detach( 'search' );
    }
    
    my $dist = $c->model('DBIC::Dist')->get_dist($distname);
    if( !$dist ) {
        $c->stash->{ template } = 'dist/search';
        $c->detach( 'search', [ $distname ] );
    }

    $c->stash->{dist} = $dist;
    return $dist;
}

sub json : Local Args(1) {
my ($self,$c,$distname) = @_;
$c->forward('get_dist',[ $distname ]);
}

# FIXME: All this crud should be movied into the model.
my %bys=( 
size_packed     => 'size_packed DESC,dist',
size_unpacked   => 'size_unpacked DESC,dist',
files           => 'files DESC,dist',
age             => {
    order_by=>'released,dist',
    show_field=>'released',
},
absolute_kwalitee  => { 
    join=>'kwalitee',
    prefetch=>'kwalitee',
    order_by=>'kwalitee.kwalitee desc,me.dist',
    '+select' => [ 'kwalitee.kwalitee' ],
    '+as'     => [ 'kwalitee' ],
    show_field=>'kwalitee',
},
core_kwalitee    =>  { 
    join=>'kwalitee',
    prefetch=>'kwalitee',
    order_by=>'kwalitee.rel_core_kw desc,me.dist',
    '+select' => [ 'kwalitee.rel_core_kw' ],
    '+as'     => [ 'kwalitee' ],
    show_field=>'kwalitee',
},

);

sub by : Local {
    my ( $self, $c, $fld ) = @_;
    my $by=$bys{$fld} || die "No such page: stats/by/$fld";
    my $title=$fld;
    my @order;
    if (ref($by) eq 'HASH') {
        $fld=$by->{show_field} if $by->{show_field};
        @order=%$by;
        $c->stash->{no_format}=1;
    }
    else {
        @order=(order_by=>$by);
    }
    $c->stash->{template}='dist/by_date' if $fld eq 'released';
    $c->stash->{field}=$fld;
    $c->stash->{title}=$title;
    
    $c->stash->{ list } = $c->model( 'DBIC::Dist' )->search(
        {},
        {
            @order,
            page     => $c->request->param( 'page' ) || 1,
            rows     => 40,
        }
    );
}
   
sub by_required : Local {
    my ( $self, $c, $fld ) = @_;
    $c->stash->{field}=$fld;
    $c->stash->{template}='dist/by';
    
    $c->stash->{ list } = $c->model( 'DBIC::Dist' )->search_related(
        'requiring',
        { 'requiring.in_dist'=> { '>'=>'0' } },
        {
            select  => [{count=>'requiring.in_dist'}],
            #as      => [qw(in_dist count)],
            group_by    => [qw(in_dist)],
            page     => $c->request->param( 'page' ) || 1,
            rows     => 40,
        }
    );


}



# TODO move to Kwalitee
sub shortcoming : Local {
    my ( $self, $c ) = @_;
    my $sc = $c->req->param( 'metric' );

    $c->stash->{ list } = $c->model( 'DBIC::Dist' )->search(
        {
            "kwalitee.$sc" => 0,
        },
        {
            join     => [ qw( kwalitee ) ],
            order_by => 'me.dist',
            page     => $c->request->param( 'page' ) || 1,
            rows     => 40,
        }
    );
}

sub complying : Local {
    my ( $self, $c ) = @_;
    my $sc = $c->req->param( 'metric' );

    $c->stash->{ list } = $c->model( 'DBIC::Dist' )->search(
        {
            "kwalitee.$sc" => 1,
        },
        {
            join     => [ qw( kwalitee ) ],
            order_by => 'me.dist',
            page     => $c->request->param( 'page' ) || 1,
            rows     => 40,
        }
    );
}


sub clean_distname {
    my ( $self, $distname ) = @_;
    my $distname_colons = $distname;

    if ( $distname =~ /::/ ) {
        $distname = ~s/::/-/g;
    } else {
        $distname_colons = ~s/-/::/g;
    }

    return ( $distname, $distname_colons );
}   

'listening to: Nightmares on Wax - in a space outta sound';

__END__

=head1 NAME

Module::CPANTS::Site::Controller::Dist - Catalyst Controller

=head1 SYNOPSIS

See L<Module::CPANTS::Site>

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS


=head1 AUTHOR

Thomas Klausner, <domm@cpan.org>

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.