Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
XP is just a number
 
PerlMonks  

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

by jeffa (Chancellor)
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
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 wandering the Monastery: (5)
As of 2014-04-19 13:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (480 votes), past polls