Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/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

In reply to hugepad by Rudif

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (2)
    As of 2020-11-26 20:48 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?