Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Apache::CVS::HTML + Perl::Tidy

by jeffa (Bishop)
on Dec 29, 2002 at 18:08 UTC ( #222936=CUFP: print w/ replies, xml ) Need Help??

Apache::CVS is a mod_perl handler that provides a web interface to CVS repositories. It's distro includes a subclass, Apache::CVS::HTML, which outputs HTML instead of plain ole text. Perl::Tidy is the core of perltidy, a utility that indents and reformats Perl scripts, as well as provides an excellent syntax highlighter via HTML and CSS. Put the two together and you have a web interface to a CVS repository with syntax highlighting.
package Apache::CVS::Tidy; use strict; use warnings; use base qw(Apache::CVS::HTML); use Perl::Tidy; use CGI qw(start_html); sub print_page_header { my $self = shift; return if $self->page_headers_sent(); $self->request()->print(start_html( -title => 'CVS Repository', -style => { src => '/path/to/perltidy.css' }, )); $self->print_path_links(); $self->page_headers_sent(1); } sub print_text_revision { my ($self,$content) = @_; my $html; perltidy( source => \$content, destination => \$html, argv => '-html -npod -css=/path/to/perltidy.css', errorfile => '/dev/null', ); # big thanks to Beatnik for this little snippet # Apache::CVS::HTML double-spaces the code, this remedies that $html =~ s/\n\n/\n/g; $self->request()->print($html); } 1;

And an example stylesheet:

body {background: #fffff3; color: #35351d} pre { color: #35351d; background: #fffff3; font-family: courier; } a { color: #de022a;} th { background: gray; } .c { color: #777777;} /* comment */ .cm { color: #35351d;} /* comma */ .co { color: #35351d;} /* colon */ .h { color: #CD5555; font-weight:bold;} /* here-doc-target */ .hh { color: #0f6d30; font-style:italic;} /* here-doc-text */ .i { color: #2c2255;} /* identifier */ .j { color: #2c2255; font-weight:bold;} /* label */ .k { color: #8d6b5f; font-weight:bold;} /* keyword */ .m { color: #2c2255; font-weight:bold;} /* subroutine */ .n { color: #B452CD;} /* numeric */ .p { color: #35351d;} /* paren */ .pd { color: #228B22; font-style:italic;} /* pod-text */ .pu { color: #35351d;} /* punctuation */ .q { color: #0f6d30;} /* quote */ .s { color: #35351d;} /* structure */ .sc { color: #35351d;} /* semicolon */ .v { color: #B452CD;} /* v-string */ .w { color: #35351d;} /* bareword */

Last note: i use the -npod option in the argv argument for perltidy() - this prevents POD from being parsed by POD::HTML. Instead, POD is simply italicized, which makes for a faster processing time.

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

Comment on Apache::CVS::HTML + Perl::Tidy
Select or Download Code
Replies are listed 'Best First'.
Re: Apache::CVS::HTML + Perl::Tidy
by PodMaster (Abbot) on Dec 30, 2002 at 10:30 UTC
    This ought to fix your newline issue ;)(i submitted it on rt.cpan.org)
    package Apache::CVS::Revision; sub content { my $self = shift; $self->_checkout() unless $self->co_file(); return undef if $self->is_binary(); open FILE, $self->co_file(); # my $content = join "\n", <FILE>; my $content = join '', <FILE>; close FILE; return $content; }
    update: caching support added, even though apache2 doesn't like Apache::CVS (will test with mod_perl1x later on). Enjoy
    package Apache::CVS::Tidy; use strict; use warnings; use base qw(Apache::CVS::HTML); use Perl::Tidy; use Cache::FileCache; ## PodMaster use CGI qw(start_html); sub print_page_header { my $self = shift; return if $self->page_headers_sent(); $self->request()->print(start_html( -title => 'CVS Repository', -style => { src => '/path/to/perltidy.css' }, )); $self->print_path_links(); $self->page_headers_sent(1); } ## PodMaster ## originally straight from Apache::CVS::HTML ## caching support added, and print_text_revision inlined sub handle_revision { my $self = shift; my ($uri_base, $revision_num) = @_; my $file = Apache::CVS::File->new($self->path(), $self->rcs_config +()); my $revision = $file->revision($revision_num); eval { if ($revision->is_binary()) { my $subrequest = $self->request()->lookup_file($revision->co_file()); $self->content_type($subrequest->content_type); $self->print_http_header(); $self->request()->send_fd($revision->filehandle()); close $revision->filehandle(); } else { $self->print_http_header(); $self->print_page_header(); my $cache = Cache::FileCache->new( { namespace => 'JeffasTidyCvs', # cache_root => 'someplace' # I like the default auto_purge_on_set => 0, auto_purge_on_get => 0, directory_umask => '077', # i don't care } ); my $key = $file->path().$file->name().$revision->number(); my $content = $cache->get($key) if defined $cache; if( defined $content ){ ## is it cached? PodMaster $self->request()->print($content); } else { ## your sub print_text_revision my $html; $content = $revision->content(); perltidy( source => \$content, destination => \$html, argv => '-html -npod -css=/path/to/perltidy.c +ss', errorfile => '/dev/null', ); $cache->set($key,$html) if defined $cache; $self->request()->print($html); } } }; if ($@) { $self->request()->log_error($@); $self->print_error("Unable to get revision.\n$@"); return; } } 1; package Apache::CVS::Revision; sub content { my $self = shift; $self->_checkout() unless $self->co_file(); return undef if $self->is_binary(); open FILE, $self->co_file(); # my $content = join "\n", <FILE>; my $content = join '', <FILE>; close FILE; return $content; } 1;

    update:
    So sorry honourable jeffa, I was saving the plaintext($content) instead of the html ($html), fixed now ;)

    update:
    After much debugging, Apache::CVS is sweet, but it relies on unportable code (damn, Rcs sucks)


    MJD says you can't just make shit up and expect the computer to know what you mean, retardo!
    ** The Third rule of perl club is a statement of fact: pod is sexy.

      Beautiful! This is so much better and lightning fast on the reload. Thanks PodMaster! :)

      jeffa

      L-LL-L--L-LL-L--L-LL-L--
      -R--R-RR-R--R-RR-R--R-RR
      B--B--B--B--B--B--B--B--
      H---H---H---H---H---H---
      (the triplet paradiddle with high-hat)
      
Re: Apache::CVS::HTML + Perl::Tidy
by boo_radley (Parson) on Jan 03, 2003 at 07:44 UTC
    This is really cool, jeffa :-)
    Somewhere along the lines, you need to check your commit comments for html (see rev 1.77), though.
      I just moved the repository from mobius (which is dying soon) to unlocalhost, so i changed your link above. Shortly after, i thought that i should finally get around to fixing the problem. :D

      Here is the shortest workaround i could come up with:

      # somewhere at top add this use HTML::Entities; # and somewhere in the middle add this sub print_revision { my $self = shift; my @time_units = ('days', 'hours', 'minutes', 'seconds'); my ($uri_base, $revision, $diff_revision) = @_; my $revision_uri = "$uri_base?r=" . $revision->number(); my $date = localtime($revision->date()); my $age = join(', ', map { $revision->age()->{$_} . ' ' . $_ } @time_units); my $symbol = $revision->symbol() || '&nbsp;'; $self->request()->print("<tr> <td><a href=$revision_uri>" . $revision->number() . '</td>' . '<td>' . $revision->author() . '</td>' . '<td>' . $revision->state() . '</td>' . "<td>$symbol</td><td>$date</td><td>$age</td>" . '<td>' . encode_entities($revision->comment()) . '</td>'); if ($diff_revision eq $revision->number()) { $self->request()->print('<td>selected for diff</td>'); } else { if ($diff_revision) { $self->request()->print(qq|<td><a href="$uri_base?ds=| . $revision->number() . qq|&dt=$diff_revision">select for diff | . "with $diff_revision</a>"); } else { $self->request()->print(qq|<td><a href="$uri_base?ds=| . $revision->number() . '">select for diff</a>'); } } $self->request()->print('</tr>'); }
      The magic line is:
      '<td>' . encode_entities($revision->comment()) . '</td>');
      ugly hack (having to repeat all of that code) .. but it works ;)

      jeffa

      L-LL-L--L-LL-L--L-LL-L--
      -R--R-RR-R--R-RR-R--R-RR
      B--B--B--B--B--B--B--B--
      H---H---H---H---H---H---
      (the triplet paradiddle with high-hat)
      

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://222936]
Approved by lemming
Front-paged by newrisedesigns
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2015-07-30 07:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (270 votes), past polls