view release on metacpan or  search on metacpan

lib/Labyrinth/Plugin/CPAN/Report.pm  view on Meta::CPAN

Return the RSS feed for a given distribution.

=item load_rss

Reads the appropriate JSON file and returns an RSS feed.

=item make_rss

Creates an RSS feed from a given data set.

=item AuthorYAML

Return the YAML feed for a given author.

=item DistroYAML

Return the YAML feed for a given distribution.

=item load_yaml

Reads the appropriate JSON file and returns an YAML feed.

=back

=cut

sub View {
    if($cgiparams{id} =~ /^\d+$/) {
        my @rows = $dbi->GetQuery('hash','GetStatReport',$cgiparams{id});
        if(@rows) {
            if($rows[0]->{guid} =~ /^[0-9]+\-[-\w]+$/) {
                my $id = guid_to_nntp($rows[0]->{guid});
                _parse_nntp_report($id);
            } else {
                $cgiparams{id} = $rows[0]->{guid};
                _parse_guid_report();
            }
        } else {
            #$tvars{errcode} = 'NEXT';
            #$tvars{command} = 'cpan-distunk';
        }
   } else {
        my $id = guid_to_nntp($cgiparams{id});
        if($id) {
            _parse_nntp_report($id);
        } else {
          _parse_guid_report();
        }
    }

    unless($tvars{article}{article}) {
        if($cgiparams{id} =~ /^\d+$/) {
            $tvars{article}{id} = $cgiparams{id};
        } else {
            $tvars{article}{guid} = $cgiparams{id};
        }
    }

    if($cgiparams{raw}) {
        $tvars{article}{raw} = $cgiparams{raw};
        $tvars{realm} = 'popup';
    } else {
        $tvars{realm} = 'wide';
    }
}

sub AuthorRSS { load_rss('author'); }
sub DistroRSS { load_rss('distro'); }

sub load_rss {
    my $type = shift;
    my $nopass = 0;

    if($cgiparams{name} =~ /(.*)\-nopass/) {
        $cgiparams{name} = $1;
        $nopass = 1;
    }

    my @dt = localtime(time);
    my $olddate = sprintf "%04d%02d%02d%02d%02d", $dt[5]+1899, $dt[4], $dt[3], $dt[2], $dt[1];

    my $cache = sprintf "%s/static/%s/%s/%s", $settings{webdir}, $type, substr($cgiparams{name},0,1), $cgiparams{name};
    #LogDebug("cache=$cache");

    # load JSON data if available
    if(-f "$cache.json") {
        my $json = read_file("$cache.json");
        my $data = decode_json($json);
        my @reports;
        for my $row (sort {$b->{fulldate} <=> $a->{fulldate}} @$data) {
            next    if($row->{fulldate} lt $olddate); # ignore anything older than a year
            next    if($nopass && $row->{state} =~ /PASS|NA/i);
            push @reports, $row;
        }

        $type = 'nopass'    if($nopass);
        $tvars{body} = make_rss( $type, $cgiparams{name}, \@reports );

    # fall back to any existing RSS
    } else {
        my $file = $nopass ? "$cache-nopass.rss" : "$cache.rss";
        $tvars{body} = read_file("$cache.rss")  if(-f $file);
    }

    $tvars{realm} = 'rss';
}

sub make_rss {
    my ( $type, $item, $data ) = @_;
    my ( $title, $link, $desc );

    if($type eq 'distro') {
        $title = "$item CPAN Testers Reports";
        $link  = "http://www.cpantesters.org/distro/".substr($item,0,1)."/$item.html";
        $desc  = "Automated test results for the $item distribution";
    } elsif($type eq 'recent') {
        $title = "Recent CPAN Testers Reports";
        $link  = "http://www.cpantesters.org/static/recent.html";
        $desc  = "Recent CPAN Testers reports";
    } elsif($type eq 'author') {
        $title = "Reports for distributions by $item";