#!/usr/bin/perl -w
#
# hugepad is a viewer for huge (*) text files, by Rudi Farkas (C) 2005
#
# (*) tested up to 500 MB
#

use strict;

######################################################################
+############

package FileIndexer;

# opens a text file, indexes file lines and fetches them on demand

our $VERSION = 0.1;

# requires filename of a text file of a reasonable size
# opens and indexes the file
sub new {
    my ( $class, %args ) = @_;
    my $self = {
        file  => $args{file}  || '',
        debug => $args{debug} || 0,
    };
    bless $self, $class;
    open( my $in, $self->{file} ) or die "Couldn't read $self->{file}:
+ $!";
    $self->{filehandle} = $in;
    $self->_indexFileLines();
    return $self;
}

# requires 0-based indexes of first line and of last line to fetch fro
+m file
# returns the array of lines requested
sub getLines {
    my $self = shift;
    my $i    = shift || 0;
    my $k    = shift;
    $k = $i unless defined $k;
    my @lines;
    my $fh = $self->{filehandle};
    $i = 0 if $i < 0;
    my $numlines = $self->numLines();
    $k = $numlines - 1 if $k >= $numlines;

    for my $j ( $i .. $k ) {
        my $linestart = unpack( 'd', substr $self->{index}, $j * 8, 8 
+);
        last unless defined $linestart;
        my $ok = seek $fh, $linestart, 0;
        chomp( $_ = <$fh> );
        push @lines, $_;
    }
    printf STDERR "getLines $i..$k, got %d\n", @lines + 0 if $self->{d
+ebug};
    return @lines;
}

# returns the number of lines in the file
sub numLines {
    my $self = shift;
    return length( $self->{index} ) / 8;
}

# indexes the file lines
sub _indexFileLines {
    my $self = shift;
    my $fh   = $self->{filehandle};
    seek $fh, 0, 0;
    my @index = ( pack 'd', 0 );
    push @index, pack 'd', tell $fh while <$fh>;
    pop @index;
    $self->{index} = join '', @index;
}

1;

######################################################################
+############

package Inserter;

# inserts lines fetched from indexed text file into a text widget

our $VERSION = 0.1;

sub min { $_[0] < $_[1] ? $_[0] : $_[1]; }
sub max { $_[0] > $_[1] ? $_[0] : $_[1]; }

# clip a,b,c
# requires a <= c
# returns b clipped to limits a, c
sub clip { max( $_[0], min( $_[1], $_[2] ) ) }

# requires a Tk application that provides a text widget
# and suitable inserting operations (doc TBD)
sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {
        app            => $args{app},
        debug          => $args{debug} || 0,
        fileindexed    => undef,              # initially
        debug          => 0,
        text_maxlines  => 1001,               # max number of lines in
+ the text widget
        text_pagelines => 100,                # page size for medium s
+peed scrolling
        text_begin     => 0,                  # 0-based index into fil
+e, of the first file line currently in text widget
        text_end => 0,    # 0-based index into file, of the file line 
+after the last line currently in text widget

    };
    bless $self, $class;
}

# requires a filename
# opens the file, indexes it and inserts the first page into the app's
+ text widget
sub openFile {
    my $self = shift;
    my $file = shift;
    if ( -f $file ) {
        $self->{fileindexed} = undef;                               # 
+closes the open file if any
        $self->{fileindexed} = FileIndexer->new( file => $file );
        $self->{text_begin}  = 0;                                   # 
+0-based
        $self->{text_end}    = 0;                                   # 
+0-based, after the last line gotten
        $self->{app}{text}->delete( '1.0', 'end' );
        $self->appendLines( $self->{text_maxlines} );
    }
    else {

        # TODO report error
    }
}

# returns the number of lines currently in the text widget
sub textlines {
    my $self = shift;
    return $self->{text_end} - $self->{text_begin};
}

# returns the number of file lines
sub filelines {
    my $self = shift;
    if ( defined $self->{fileindexed} ) {
        return $self->{fileindexed}->numLines();
    }
    else {
        return 0;
    }
}

# requires number of lines to delete starting at the first line in the
+ text widget
# deletes specified lines from the text widget
sub deleteFirstLines {
    my $self       = shift;
    my $chunklines = shift || $self->{text_pagelines};
    my $n          = min( $chunklines, $self->textlines() );
    $self->{app}{text}->delete( '1.0', "1.0 + $n lines" );
    $self->{text_begin} += $n;
    print STDERR "deleteFirstLines $n, now: $self->{text_begin}.,$self
+->{text_end}\n" if $self->{debug};

    $self->updateMessageAndScrollbar2();
}

# requires number of lines to delete ending with the last line in the 
+text widget
# deletes specified lines from the text widget
sub deleteLastLines {
    my $self       = shift;
    my $chunklines = shift || $self->{text_pagelines};
    my $n          = min( $chunklines, $self->textlines() );
    my $from       = $self->textlines() - $n;
    $self->{app}{text}->delete( "$from.0", 'end' );
    $self->{text_end} -= $n;
    print STDERR "deleteLastLines $n, now: $self->{text_begin}.,$self-
+>{text_end}\n" if $self->{debug};

    $self->updateMessageAndScrollbar2();
}

# requires number of lines to insert after the last line in the text w
+idget
# if needed deletes some first lines from the text widget
# inserts the lines
sub appendLines {
    my $self = shift;
    unless ( defined $self->{fileindexed} ) {
        print STDERR "no file opened\n";
        return;
    }
    my $chunklines = shift || $self->{text_pagelines};

    my $tailmargin = $self->filelines() - $self->{text_end};
    $chunklines = min( $chunklines, $tailmargin );
    $chunklines = min( $chunklines, $self->{text_maxlines} );
    print STDERR "appendLines chunklines $chunklines\n" if $self->{deb
+ug};

    if ( $self->textlines() + $chunklines > $self->{text_maxlines} ) {
        $self->deleteFirstLines($chunklines);
    }

    my $new_end   = $self->{text_end} + $chunklines;
    my $new_begin = $new_end - min( $chunklines, $self->{text_maxlines
+} );

    my @lines = $self->{fileindexed}->getLines( $new_begin, $new_end -
+ 1 );

    for (@lines) {
        $self->{app}{text}->insert( 'end', "$_\n" );
    }
    $self->{text_end} += @lines;
    my $n = @lines;
    print STDERR "appendLines $n, now: $self->{text_begin}.,$self->{te
+xt_end}\n" if $self->{debug};

    $self->updateMessageAndScrollbar2();
}

# requires number of lines to prepend before the first line in the tex
+t widget
# if needed deletes some last lines from the text widget
# inserts the lines
sub prependLines {
    my $self = shift;
    unless ( defined $self->{fileindexed} ) {
        print STDERR "no file opened\n";
        return;
    }
    my $chunklines = shift || $self->{text_pagelines};
    $chunklines = min( $chunklines, $self->{text_begin} );
    $chunklines = min( $chunklines, $self->{text_maxlines} );
    print STDERR "prependLines chunklines $chunklines\n" if $self->{de
+bug};

    if ( $self->textlines() + $chunklines > $self->{text_maxlines} ) {
        $self->deleteLastLines($chunklines);
    }

    my $new_begin = $self->{text_begin} - $chunklines;
    my $new_end   = $new_begin + min( $chunklines, $self->{text_maxlin
+es} );

    my @lines = $self->{fileindexed}->getLines( $new_begin, $new_end -
+ 1 );
    for ( my $i = $#lines ; $i >= 0 ; --$i ) {
        $self->{app}{text}->insert( '1.0', "$lines[$i]\n" );
    }
    $self->{text_begin} -= @lines;
    my $n = @lines;
    print STDERR "prependLines $n, now: $self->{text_begin}.,$self->{t
+ext_end}\n" if $self->{debug};

    $self->updateMessageAndScrollbar2();
}

sub replaceLines {
    my $self = shift;
    my $from = shift || 0;
    my $upto = shift || $self->filelines();    # not including the las
+t one

    # clip to maxlines preserving $chunklines if possible
    my $chunklines = $upto - $from;
    $chunklines = max( 0, $chunklines );
    $chunklines = min( $chunklines, $self->{text_maxlines} );
    $from = clip( 0, $from, $self->filelines() - $self->{text_maxlines
+} - 1 );

    # for now ignore any overlap
    $self->deleteFirstLines( $self->textlines() );

    $self->{text_begin} = $from;
    my @lines = $self->{fileindexed}->getLines( $self->{text_begin}, $
+self->{text_begin} + $chunklines - 1 );
    for (@lines) {
        $self->{app}{text}->insert( 'end', "$_\n" );
    }
    $self->{text_end} = $self->{text_begin} + @lines;
    my $n = @lines;
    print STDERR "replaceLines $n, now: $self->{text_begin}.,$self->{t
+ext_end}\n" if $self->{debug};

    $self->updateMessageAndScrollbar2();
}

# updates the message in label and the second scrollbar
sub updateMessageAndScrollbar2 {
    my $self    = shift;
    my $message = shift;
    if ( defined $message ) {
        ${ $self->{app}{messageText} } = $message;
    }
    else {
        my $filelines = 0;
        if ( defined $self->{fileindexed} ) {
            $filelines = $self->{fileindexed}->numLines();
        }
        my $text_last = $self->{text_end} - 1;
        my $textlines = $self->textlines();
        ${ $self->{app}{messageText} } = "$self->{text_begin} .. $text
+_last ($textlines of $filelines)";
    }

    # update scr2
    my $lines = $self->{text_end} - $self->{text_begin};
    if ( $lines > $self->{text_pagelines} ) {
        my $num = $self->{fileindexed}->numLines();
        if ( $num > 0 ) {
            my $fr1 = $self->{text_begin} / $num;
            my $fr2 = $self->{text_end} / $num;
            $self->{app}{scr2}->set( $fr1, $fr2 );
        }
    }
}

1;

######################################################################
+############

package main;

use Tk;
use Tk::ROText;
use Tk::DialogBox;

#use Data::Dumper;

our $VERSION = 0.11;

# create the main window, a menu frame at top, a second scrollbar at r
+ight and a scrolled ROText
my $app;
$app->{mw} = MainWindow->new( -title => "hugepad" );
$app->{menu} = $app->{mw}->Frame()->pack( -side     => "top",   -fill 
+=> "x" );
$app->{scr2} = $app->{mw}->Scrollbar()->pack( -side => 'right', -fill 
+=> 'y' );
$app->{scr2}->configure( -command => \&OnScroll2, -activerelief => 'gr
+oove' );
$app->{text} =
  $app->{mw}->Scrolled( "ROText", -scrollbars => 'se', -wrap => 'none'
+ )->pack( -fill => 'both', -expand => 1 );

# add menus and dialogs
{
    $app->{menu}{file} =
      $app->{menu}->Menubutton( -text => 'File', -underline => 0, -tea
+roff => 0 )->pack( -side => 'left' );

    $app->{menu}{file}->command(
        -label   => 'Open',
        -command => sub {
            $app->{text}->delete( '1.0', 'end' );

            my $types = [ [ 'Text Files', '.txt' ], [ 'All Files', '*.
+*', ] ];
            my $file2open = $app->{mw}->getOpenFile( -filetypes => $ty
+pes );
            openFile($file2open);
        }
    );

    $app->{menu}{file}->separator;

    $app->{menu}{file}->command(
        -label   => 'Exit',
        -command => sub {
            exit(0);
        }
    );
}
{
    $app->{dlg}{about} = $app->{mw}->DialogBox( -title => "About", -bu
+ttons => ["OK"] );
    $app->{dlg}{about}->add( "Label", -text => "hugepad\na viewer for 
+huge text files\nby Rudif" )->pack;

    $app->{dlg}{help} = $app->{mw}->DialogBox( -title => "Help", -butt
+ons => ["OK"] );
    $app->{dlg}{help}
      ->add( "Label", -text => "Open a text file.\nScroll the text usi
+ng vertical arrow and page keys, mouse wheel and scrollbars." )->pack
+;

    $app->{menu}{about} =
      $app->{menu}->Menubutton( -text => 'Help', -underline => 0, -tea
+roff => 0 )->pack( -side => 'left' );

    $app->{menu}{about}->command( -label => 'About', -command => sub {
+ $app->{dlg}{about}->Show; } );
    $app->{menu}{about}->command( -label => 'Help',  -command => sub {
+ $app->{dlg}{help}->Show; } );
}
{
    my $messageText = "   ";
    $app->{messageLabel} =
      $app->{menu}->Label( -textvariable => \$messageText, -relief => 
+'sunken' )->pack( -side => 'right' );
    $app->{messageText} = \$messageText;
}

# add Inserter
my $ins = Inserter->new( app => $app );

# add bindings for MouseWheel and for the Y arrow keys
$app->{text}->bind( "<MouseWheel>", \&OnYscrolllimit );
$app->{text}->bind( "<Key-Up>",     \&OnYarrowlimit );
$app->{text}->bind( "<Key-Down>",   \&OnYarrowlimit );

# add bindings for PgDown and PgUp keys
$app->{text}->bind( "<Key-Next>",  [ sub { $ins->appendLines(); },  Ev
+('K') ] );
$app->{text}->bind( "<Key-Prior>", [ sub { $ins->prependLines(); }, Ev
+('K') ] );

# uncomment for testing only
#$app->{text}->bind( "<Shift-Key-Next>",  [ sub { $ins->appendLines();
+ }, Ev('K') ] );
#$app->{text}->bind( "<Shift-Key-Prior>", [ sub { $ins->prependLines()
+; }, Ev('K') ] );
#$app->{text}->bind( "<Key-Home>", [ sub { $ins->deleteFirstLines(); }
+, Ev('K') ] );
#$app->{text}->bind( "<Key-End>",  [ sub { $ins->deleteLastLines(); },
+  Ev('K') ] );
#$app->{text}->bind( "<Key-Home>", [ sub { $ins->replaceLines( 4000, 4
+400 ); }, Ev('K') ] );
#$app->{text}->bind( "<Key-End>",  [ sub { $ins->replaceLines( 8000, 8
+800 ); }, Ev('K') ] );

# redefine the scrollbar's callback that tells the Text to scroll
$app->{text}->Subwidget("yscrollbar")->configure( -command => \&scroll
+callback, );

# opens the file given as command line option
my $file = shift;
if ( defined $file ) {

    $ins->openFile($file);
}

# here we go
MainLoop;

### subs

# requires a filename
# opens the file in Indexer and loads the first maxlines into the Text
+ widget
sub openFile {
    my $file = shift;
    $ins->openFile($file);
}

# callback for the inner scrollbar
# scrolls the current contents of the Text widget
sub scrollcallback {

    # scrollbar tells Text widget to scroll or moveto
    $app->{text}->yview(@_);

    OnYscrolllimit();    # additional behavior
}

# on reaching the scroll limit loads another line into the Text widget
sub OnYscrolllimit {
    my ( $top, $bot ) = $app->{text}->yview;
    if ( $top == 0 ) {
        $ins->prependLines(1);    # wheel or scrollbar try to go above
+ the first line
    }
    elsif ( $bot == 1 ) {
        $ins->appendLines(1);     # wheel or scrollbar try to go below
+ the last line
    }
}

# on arrow cursor hitting the first or last line in Text widget loads 
+another line
sub OnYarrowlimit {
    my $i = int( $app->{text}->index('insert') );
    my $e = int( $app->{text}->index('end') );
    if ( $i == 1 ) {
        $ins->prependLines(1);    # up arrow hits the first line
    }
    elsif ( $i == $e - 1 ) {
        $ins->appendLines(1);     # down arrow hits the last line
    }
}

# requires a scroll command and a quantity to scroll to or scroll by
sub OnScroll2 {
    my ( $cmd, $qty ) = @_;
    if ( $cmd eq 'moveto' ) {

        # $qty (0..1) designates the relative position in file
        # of the first line to load into the text widget
        my $new_begin = int( $qty * $ins->filelines() );
        my $new_end   = $new_begin + $ins->{text_maxlines};
        $ins->replaceLines( $new_begin, $new_end );
    }
    elsif ( $cmd eq 'scroll' ) {

        #scroll by 1 page
        if ( $qty == -1 ) {
            $ins->prependLines();
        }
        elsif ( $qty == 1 ) {
            $ins->appendLines();
        }
    }
}

__END__


=head1 NAME

hugepad.pl - Perl/Tk program for viewing huge text files

=head1 SYNOPSIS

  hugepad [somehugefile.txt]

=head1 DESCRIPTION

hugepad opens a text file of up to several hundred megabytes 
for viewing in a Tk ROText window.

You can scroll the file contents using vertical arrow keys, mouse whee
+l (Windows only?), 
Page Up/Down keys and two vertical scrollbars, for fine and coarse (ra
+pid) scrolling.

It has no editing capability at this time.

=head1 VERSION

Preliminary. Comments and suggestions for improvement are welcome.

=head1 TODO

=over 4

=item * make pagesize dynamic ?

=item * goto line

=item * find

=item * filter lines with a regexp and save

=back

=head1 ACKNOWLEDGEMENTS

[BrowserUk] of perlmonks for the file indexing algorithm

[zentara] of perlmonks for advice on Tk widget method rebinding

Paul Malcher for kpad

Steve Hancock for perltidy

=head1 BUGS

No unit tests

Tested only on WinXP

Error handling is rough

=head1 FIXED BUGS

=over 4

=item initial dir in getOpenFile

I< The script has 'h:\' as initial dir, which seems silly for *NIX mac
+hines and even for most Win32 machines that have no h:\ 'share' mount
+ed.>

Removed the option -initialdir from getOpenFile() call.

=back



=head1 AUTHOR

Rudi Farkas, [Rudif] of perlmonks

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 by Rudi Farkas

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.


=cut
[download]