#!/usr/bin/perl -w
#
# line-number CGI script
#
# tkil@scrye.com 1999-12-19
#
# just a little script to let me discuss code more sanely.  i believe
# that randal schwartz did a much better job in one of his web
# techniques columns at some point, but i haven't gotten around to
# looking it up yet.

use strict;

# module-o-matic.
use CGI;
use Text::Tabs qw(expand);
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use HTML::Entities qw(encode_entities);

# parse parameters
my $q = CGI->new();
my $url = $q->param('url');

# accept trailling paths
unless ($url)
{
    $url = $q->path_info();
    $url =~ s|^/||;

    $q->param('url', $url)
      if $url;
}

# look for a normal parameter
unless ($url)
{
    $url = $q->param('url');
}

# make a title that is short and to the point.
my $title = "Line Numberer";
if ($url)
{
    $title = $url;
    $title =~ s|.*/||;
    $title .= ' Listing';
}

# start the HTML output page
print
  $q->header(),
  $q->start_html($title);


# unless we have a url to display, we just present the blank.
goto END_PAGE 
  unless ($url);

# form at the top of the page
emit_form($q);
print "<hr>\n";

# paranoia.  otherwise, people could submit "file:" requests and find
# things on my box.  naughty.
unless ($url =~ /^http:/)
{
    print 
      $q->p("NAUGHTY.  Only fully-qualified HTTP-scheme URLs are permitted.");
    goto END_PAGE;
}

# build a useragent for our requests
my $ua = LWP::UserAgent->new;
$ua->agent("Tkil Line Numberer/1.0");

# get the head, make sure it's not too long
my $head_req = HTTP::Request->new(HEAD => $url);
$head_req->header(Accept => 'text/*');
my $head_resp = $ua->request($head_req);
unless ($head_resp->is_success)
{
    # we couldn't find it at all
    print 
      $q->p("Could not fetch HEAD of URL $url: " . $head_resp->status_line());
    goto END_PAGE;
}

unless ($head_resp->content_type =~ m|^text/|)
{
    # it doesn't seem to be text.  (not sure why the "accept" method
    # isn't blocking this, but this is almost as easy...
    print $q->p("Sorry, but URL $url doesn't seem to be a text type.");
    goto END_PAGE;
}

my $content_length = $head_resp->content_length();
if ( ! defined($content_length) || $content_length > 100_000)
{
    # "the full text of war and peace" *indeed*.
    print $q->p("Sorry, but URL $url is too large " .
                "(size=$content_length &gt; 100kB max)");
    goto END_PAGE;
}

# get the actual contents
my $req = HTTP::Request->new(GET => $url);
$req->header(Accept => 'text/*');
my $resp = $ua->request($req);
unless ($resp->is_success)
{
    print $q->p("Could not fetch contents of URL $url: " .
                $resp->status_line() );
    goto END_PAGE;
}

# display them
my $lines_per_band = 5;
my @colors = ( "#cccccc", "#bbddbb" );
my $cur_color = 0;

my $cur_line = 0;
my $in_row = 0;

print 
  "<table columns=2 cellpadding=0 cellspacing=0>\n",
  "<caption>Listing of <a href='$url'>$url</a></caption>\n";

# go through each line, splitting on end of line (which is either CRLF
# or just LF ... or just CR, i suppose.)
foreach my $line (split /\012|\015\012|\015/, $resp->content())
{
    if ($cur_line % $lines_per_band == 0)
    {
        # end previous row
        print "</tt></td></tr>\n" if $in_row;

        # start new row
        print 
          "<tr bgcolor='$colors[$cur_color]'>",
          "<td align='right' valign='top'>$cur_line&nbsp;&nbsp;</td>",
          "<td><tt>";

        ++ $cur_color;
        $cur_color %= @colors;

        $in_row = 1;
    }

    # clean up the text so that it's displayed correctly
    my $html_line = encode_entities(expand($line));
    $html_line =~ s/\s+$//;
    $html_line =~ s/ /&nbsp;/g; # ugh.

    # and display it, along with a "line break".
    print $html_line, "<br>\n";

    ++ $cur_line;
}

# end last row
print "</tt></td></tr>\n" if $in_row;
$in_row = 0;

print "</table>\n";

END_PAGE:

print "<hr>\n";
emit_form($q);

print
  $q->end_html();

exit 0;

# i envision putting an entry blank at the top and at the bottom, so i
# wrote this function to emit it.
sub emit_form
{
    my $q = shift;
    print 
      $q->start_form( -method => 'GET' ),
      "URL to display: ",
      $q->textfield(-name => 'url',
                    -size => 70),
      $q->submit,
      $q->end_form;
}