view release on metacpan or  search on metacpan

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

        $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}));
    }
    
    push(@print,"</table>",$self->_html_footer);

    $out->spew(iomode => '>:encoding(UTF-8)', \@print );

}


sub gen_cool_values {
    my ($self, $dists) = @_;

    my $out = Path::Class::Dir->new($self->out)->file('values.html');
    my @print;

    push(@print,$self->_html_header);
    push(@print,<<EOBADINTRO);
<h3>Cool Return Values</h3>
<p class="content">
All cool values, sorted by number of occurence in the CPAN.
</p>

<table>
<tr><td>Count</td><td>Return value</td><td>Packages</td></tr>
EOBADINTRO

    my $cnt=1;
    foreach my $rv (
        map { $_->[1] }
        sort { $b->[0] <=> $a->[0] }
        map { [scalar @{$dists->{$_}},$_] } keys %$dists) {
        push(@print,$self->_html_cool_value($rv,$dists->{$rv},'cv_'.$cnt++));
    }

    push(@print,"<table>");
    push(@print,$self->_html_footer);
    $out->spew(iomode => '>:encoding(UTF-8)', \@print);
}


sub gen_bad_dists {
    my ($self, $dists) = @_;

    my $out = Path::Class::Dir->new($self->out)->file('bad.html');
    my @print;

    push(@print,$self->_html_header);
    push(@print,<<EOBADINTRO);
<h3>Bad Return Values</h3>

<p class="content">A list of distributions that don't return a valid 
return statement. You can consider this distributions buggy. This list 
is further broken down into the type of <a 
href="https://metacpan.org/pod/PPI">PPI::Statement</a> class they 
return. To view the full bad return value, click on the 
'show'-link.</p>
EOBADINTRO

    my @bad = sort keys %$dists;
    push(@print,"<ul>");
    foreach my $type (@bad) {
        my $count = keys %{$dists->{$type}};
        push(@print,"<li><a href='#$type'>$type ($count dists)</li>");
    }
    push(@print,"</ul>");
    
    foreach my $type (sort keys %$dists) {
        push(@print,"<h3><a name='$type'>$type</a></h3>\n<table width='100%'>");
        foreach my $dist (sort keys %{$dists->{$type}}) {
            push(@print, $self->_html_bad_dist($dist,$dists->{$type}{$dist}));

        }
        push(@print,"</table>");
    }
    
    push(@print,"</table>");
    push(@print,$self->_html_footer);
    $out->spew(iomode => '>:encoding(UTF-8)', \@print);
}


sub gen_index {
    my $self = shift;
    my $out = Path::Class::Dir->new($self->out)->file('index.html');
    my @print;
    my $version = Acme::ReturnValue->VERSION;

    push(@print,$self->_html_header);
    push(@print,<<EOINDEX);

<p class="content">As you might know, all <a href="https://perl.org">Perl</a> packages are required to end with a true statement, usually '1'. But there are more interesting true values than plain old boring '1'. This site is dedicated to presenting ...

<p class="content">This site is created using <a href="https://metacpan.org/pod/Acme::ReturnValue">Acme::ReturnValue $version</a> by <a href="https://domm.plix.at">Thomas Klausner (domm)</a> on irregular intervals (but setting up a cron-job is on the...

<p class="content">At the moment, there are the following reports:
<ul class="content">
<li><a href="values.html">Cool values</a> - all cool values, sorted by number of occurence in the CPAN</li>
<li><a href="cool_A.html">Cool dists</a> - a list of distributions with not-boring return values. There still are some false positves hidden in here, which will hopefully be removed soon.</li>
<li><a href="bad.html">Bad return values</a> - a list of distributions that don't return a valid return statement. You can consider this distributions (or Acme::ReturnValue) buggy.</li>
<li>By author - not implemented yet.
</ul>
</p>

EOINDEX
    push(@print,$self->_html_footer);
    $out->spew(iomode => '>:encoding(UTF-8)', \@print);
}

sub _html_cool_dist {
    my ($self, $dist,$report) = @_;
    my $html;
    my $count = @$report;

    if ($count>1) {
        $html.="<tr><td colspan=2>".$self->_link_dist($dist)."</td></tr>";
    }

    foreach my $ele (@$report) {
        my $val=$ele->{'value'};

        if ($count>1) {
            $html.="<tr><td class='package'>".$ele->{package_br}."</td>";
        }
        else {
            $html.="<tr><td colspan>".$self->_link_dist($dist)."</td>";
        }
        $html.="<td>".$val."</td>";
        $html.="</tr>\n";
    }
    return $html;
}

sub _html_cool_value {
    my ($self, $value, $report, $id) = @_;
    my $html;
    my $count = @$report;
    $html = qq[<tr><td>$count</td><td>$value</td><td><a href="javascript:void(0)" onclick="] . q[$('#]. $id. q[').toggle()">show</td></td></tr>].
qq[<tr id='$id' style='display:none' ><td></td><td colspan=2>];
    $html .= join("<br>\n",map { $self->_link_search_package($_->{package}) } sort { $a->{package} cmp $b->{package} } @$report);
    $html .= "</td></tr>";
    return $html;
}

sub _html_bad_dist {
    my ($self, $dist,$report) = @_;
    my $html;

    foreach my $ele (@$report) {
        my $val=$ele->{'bad'} || '';
        my $id = $ele->{package};
        $id=~s/::/_/g;
        $html.="<tr><td colspan width='30%'>".$self->_link_dist($dist)."</td>";
        $html.="<td width='69%'>".$ele->{package}."</a></td>".
        q{<td width='1%'><a href="javascript:void(0)" onclick="$('#}.$id.q{').toggle()">}."show</td></tr>
        <tr id='$id' style='display:none' ><td></td><td colspan=2>".$val."</td></tr>";
    }
    return $html;
}

sub _link_dist {
    my ($self, $dist) = @_;
    my $distlink = $dist;
    $distlink=~s/-[\d\.]+$//;
    return "<a href='https://metacpan.org/release/$distlink'>$dist</a>";
}

sub _link_search_package {
    my ($self, $package) = @_;
    return "<a href='https://metacpan.org/pod/$package'>$package</a>";
}

sub _html_header {
    my $self = shift;

    return <<"EOHTMLHEAD";
<html>
<head><title>Acme::ReturnValue findings</title>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=utf-8">
<script src="jquery-1.3.2.min.js" type="text/javascript"></script>
<link href="acme_returnvalue.css" rel="stylesheet" type="text/css">

</head>

<body>
<h1 id="top">Acme::ReturnValue</h1>

<ul id="menubox" class="menu">
<li><a href="index.html">About</a></li>
<li><a href="values.html">Cool return values</a></li>
<li><a href="cool_A.html">Cool dists</a></li>
<li><a href="bad.html">Bad return values</a></li>
</ul>
</div>
EOHTMLHEAD
}

sub _html_footer {
    my $self = shift;
    my $now = $self->now;