view release on metacpan or  search on metacpan

lib/Acme/ReturnValue/MakeSite.pm  view on Meta::CPAN

package Acme::ReturnValue::MakeSite;

# ABSTRACT: generate returnvalues.plix.at
our $VERSION = '1.004'; # VERSION

use 5.010;
use strict;
use warnings;

use Path::Class qw();
use URI::Escape;
use Encode qw(from_to);
use Data::Dumper;
use Acme::ReturnValue;
use Encode;
use Moose;
use JSON;
with qw(MooseX::Getopt);
use MooseX::Types::Path::Class;

has 'now' => (is=>'ro',isa=>'Str',default => sub { scalar localtime});
has 'quiet' => (is=>'ro',isa=>'Bool',default=>0);
has 'data' => (is=>'ro',isa=>'Path::Class::Dir',default=>'returnvalues',coerce=>1);
has 'out' => (is=>'ro',isa=>'Path::Class::Dir',default=>'htdocs',coerce=>1);
has 'json_decoder' => (is=>'ro',lazy_build=>1);
sub _build_json_decoder {
    return JSON->new;
}



sub run {
    my $self = shift;

    my @interesting;

    my %cool_dists;
    my %bad_dists;
    my %cool_rvs;
    #my %authors;

    if (!-d $self->out) {
        $self->out->mkpath || die "cannot make dir ".$self->out;
    }

    my $dir = $self->data;
    while (my $file=$dir->next) {
        next unless $file=~/\/(?<dist>.*)\.json$/;
        my $dist=$+{dist};
        $dist=~s/^\///;

        my $json = $file->slurp(iomode => '<:encoding(UTF-8)');
        my $data = $self->json_decoder->decode($json);
        next if ref($data) eq 'HASH' && $data->{is_boring};
        foreach my $rreport (@$data) {
            my $report = { %$rreport };
            if (exists $report->{value}) {
                $report->{value}=~s/\</&lt;/g;
                $report->{value}=~s/\>/&gt;/g;
                if(length($report->{value})>255) {
                    $report->{value}=substr($report->{value},0,255).'...';
                }
            }
            if ($report->{bad}) {
                my $bad = $report->{bad};
                $bad=~s/\</&lt;/g;
                $bad=~s/\>/&gt;/g;
                if(length($bad)>255) {
                    $bad=substr($bad,0,255).'...';
                }
                $report->{bad}=$bad;
            }

            $report->{package_br} = $report->{package};
            if (length($report->{package_br})>40) {
                my @p=split(/::/,$report->{package_br});
                my @lines;
                my $line = shift(@p);
                foreach my $frag (@p) {
                    $line.='::'.$frag;
                    if (length($line)>40) {
                        push(@lines,$line);
                        $line='';
                    }
                }
                push (@lines,$line) if $line;
                $report->{package_br}=join("<br>&nbsp;&nbsp;&nbsp;",@lines);
            }
            if ($report->{value}) {
                push(@{$cool_dists{$dist}},$report);
                push(@{$cool_rvs{$report->{value}}},$report);
            }
            else {
                push(@{$bad_dists{$report->{PPI}}{$dist}},$report);
            }
        }
    }
    
    my %by_letter; 
    foreach my $dist (sort keys %cool_dists) {
        my $first = uc(substr($dist,0,1));
        push(@{$by_letter{$first}},$dist);
    }
    my $letternav = "<ul class='menu'>";
    foreach my $letter (sort keys %by_letter) {
        $letternav.="<li><a href='cool_$letter.html'>$letter</a></li>";
    }
    $letternav.="</ul>";
    foreach my $letter (sort keys %by_letter) {
        $self->gen_cool_dists(\%cool_dists,$by_letter{$letter},$letter,$letternav); 
    }
   
    $self->gen_cool_values(\%cool_rvs);

    $self->gen_bad_dists(\%bad_dists); 
   
    $self->gen_index;

}


sub gen_cool_dists {
    my ($self, $cool,$dists,$letter,$letternav) = @_;

    my $out = Path::Class::Dir->new($self->out)->file('cool_'.$letter.'.html');

    my $count = keys %$cool;
    my @print;

    push(@print,$self->_html_header);
    push(@print,<<EOCOOLINTRO);
<h3>$count Cool Distributions $letter</h3>
<p class="content">A list of distributions with not-boring return 
values, sorted by name. </p>
EOCOOLINTRO
   
    push(@print,$letternav);

    push(@print,"<table>");
    foreach my $dist (sort @{$dists}) {
        push(@print,$self->_html_cool_dist($dist,$cool->{$dist}));