view release on metacpan or  search on metacpan

vhost/cgi-bin/view-report.cgi  view on Meta::CPAN

#    for my $key (keys %rules) {
#        my $val = $cgi->param("${key}_pref");
#        $cgiparams{$key} = $1   if($val =~ $rules{$key});
#    }

    LogDebug('DEBUG: cgiparams=',Dumper(\%cgiparams));
    audit("AUDIT[$$]: stop init_options");
}

sub process_report {
    audit("AUDIT[$$]: start retrieve_report - $cgiparams{id}");
    retrieve_report();
    audit("AUDIT[$$]: stop retrieve_report");
    audit("AUDIT[$$]: start print_report");
    print_report();
    audit("AUDIT[$$]: stop print_report");
}

sub retrieve_report {
    $tvars{body}{result} = '""';

    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';
        }
   } elsif($cgiparams{id} =~ /^[\w-]+$/) {
        my $id = guid_to_nntp($cgiparams{id});
        if($id) {
            _parse_nntp_report($id);
        } else {
            _parse_guid_report();
        }
    } else {
        $cgiparams{id} =~ s/[\w-]+//g;
    }

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

    if($cgiparams{json}) {
        $tvars{body}{success} = $tvars{body}{result} && $tvars{body}{result} ne '""' ? 1 : 0;
        $tvars{layout}  = 'public/layout.json';
    } elsif($cgiparams{raw}) {
        $tvars{article}{raw} = $cgiparams{raw};
        $tvars{layout} = 'public/popup.html'
    } else {
        $tvars{layout} = 'public/layout-wide.html'
    }
}

sub print_report {
    $tvars{content}     = 'cpan/report-view.html';
    $tvars{siteversion} = $VERSION;
    $tvars{labversion}  = $Labyrinth::VERSION;
    Publish();
}

#----------------------------------------------------------------------------
# Private Interface Functions

sub _parse_nntp_report {
    my $nntpid = shift;
    my @rows;

    unless($nntpid) {
       @rows = $dbi->GetQuery('hash','GetStatReport',$cgiparams{id});
       return  unless(@rows);
       $nntpid = guid_to_nntp($rows[0]->{guid});
    }

    @rows = $dbi->GetQuery('hash','GetArticle',$nntpid);
       return  unless(@rows);

    if($rows[0]->{article} =~ /Content-Transfer-Encoding: quoted-printable/is) {
        my ($head,$body) = split(/\n\n/,$rows[0]->{article},2);
        $body = decode_qp($body);
        $rows[0]->{article} = $head . "\n\n" . $body;
    }

    $rows[0]->{article} = demoroniser($rows[0]->{article});
    $rows[0]->{article} = SafeHTML($rows[0]->{article});
    $tvars{article} = $rows[0];
    ($tvars{article}{head},$tvars{article}{body}) = split(/\n\n/,$rows[0]->{article},2);

    my $object = CPAN::Testers::Common::Article->new($rows[0]->{article});
    return  unless($object);

    $tvars{article}{nntp}    = 1;
    $tvars{article}{id}      = $cgiparams{id};
    $tvars{article}{body}    = $object->body;
    $tvars{article}{subject} = $object->subject;
    $tvars{article}{from}    = $object->from;
    $tvars{article}{from}    =~ s/\@.*//;
    $tvars{article}{post}    = $object->postdate;

    my @date = $object->date =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/;
    $tvars{article}{date}    = sprintf "%04d-%02d-%02dT%02d:%02d:00Z", @date;

    return      if($tvars{article}{subject} =~ /Re:/i);
    return      unless($tvars{article}{subject} =~ /(CPAN|FAIL|PASS|NA|UNKNOWN)\s+/i);

    my $state = lc $1;

    if($state eq 'cpan') {
        if($object->parse_upload()) {