view release on metacpan or  search on metacpan

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

}

sub decode_report {
    my $report = shift;
    my $hash;

    # do we have an encoded report object?
    if(ref $report eq 'CPAN::Testers::Report') {
        $hash = $report->as_struct;
        $hash->{content} = decode_json($hash->{content});
        for my $content (@{ $hash->{content} }) {
            $content->{content} = decode_json($content->{content});
        }
        
        return encode_json($hash);
    }

    # we have a manufactured hash, with a collection of fact objects

    eval {
        for my $fact (@{ $report->{content} }) {
            $fact->{content} = decode_json($fact->{content});
        }
    };

    return  if($@);

    return encode_json($report);

#    my $hash = { 'CPAN::Testers::Report' => { metadata => $report->{metadata}, content => {} } };

    my @facts = $report->facts();
    for my $fact (@facts) {
        my $name = ref $fact;
        $hash->{'CPAN::Testers::Report'}->{content}{$name} = $fact->as_struct();
    }
    return $hash;
}

sub dereference_report {
    my ($report) = @_;
    my %facts;

    eval {
        my @facts = $report->facts();
        for my $fact (@facts) {
            my $name = ref $fact;
            $facts{$name} = $fact->as_struct;
            $facts{$name}{content} = decode_json($facts{$name}{content});
        }
    };

    return  if($@);

    return \%facts;
}

sub get_tester {
    my $creator = shift;

    #$dbi->{'mysql_enable_utf8'} = 1;
    my @rows = $dbi->GetQuery('hash','GetTesterFact',$creator);
    return ($creator,$creator)  unless(@rows);

    #$rows[0]->{fullname} = encode_entities($rows[0]->{fullname});
    my $name = $rows[0]->{fullname};
    $name = join(' ',$rows[0]->{name},$rows[0]->{pause})    if($rows[0]->{name});

    my $email = $rows[0]->{contact} || $rows[0]->{email} || $creator;
    $email =~ s/\'/''/g if($email);
    return ($name,$email);
}

sub error {
    LogError('ERROR:',@_);
    print STDERR @_;
    print $cgi->header('text/plain'), "Error retrieving data\n";
    exit;
}

sub audit {
    return  unless($AUDIT);

    my @date = localtime(time);
    my $date = sprintf "%04d/%02d/%02d %02d:%02d:%02d", $date[5]+1900, $date[4]+1, $date[3], $date[2], $date[1], $date[0];

    my $fh = IO::File->new($VHOST . 'cgi-bin/cache/view-report-audit.log','a+') or return;
    print $fh "$date " . join(' ',@_ ). "\n";
    $fh->close;
}

1;

__END__

=head1 BUGS, PATCHES & FIXES

There are no known bugs at the time of this release. However, if you spot a
bug or are experiencing difficulties, that is not explained within the POD
documentation, please send bug reports and patches to the RT Queue (see below).

Fixes are dependant upon their severity and my availablity. Should a fix not
be forthcoming, please feel free to (politely) remind me.

RT: http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Testers=WWW-Reports

=head1 SEE ALSO

L<CPAN::Testers::WWW::Statistics>,
L<CPAN::Testers::WWW::Wiki>,
L<CPAN::Testers::WWW::Blog>

F<http://www.cpantesters.org/>,
F<http://stats.cpantesters.org/>,
F<http://wiki.cpantesters.org/>,
F<http://blog.cpantesters.org/>

=head1 AUTHOR

  Barbie       <barbie@cpan.org>   2008-present