in reply to head truncate

Untested, but no glaring mistakes obvious to me. If you see any, yell at me. Update: turns out there are rather serious ones. Do not use this code. Left here for posterity.
#!/usr/bin/perl -w use strict; #deletes first numbytes of a file #### DO NOT USE ##### #use constant BLOCKSIZE => 128*1024; # #die "Usage: $0 numbytes file [file ...]\n" unless @ARGV > 2; # #my $trunc_bytes = shift @ARGV; #my $files_done = 0; # #for(@ARGV) { # open(my $fh, "+<", $_) or (warn "Couldn't open $_: $!\n", next); # if(-s $fh > $trunc_bytes ) { # seek $fh, 0, $trunc_bytes; # while(my $bytes_read = read $fh, my $buffer, BLOCKSIZE) { # seek $fh, 1, -$bytes_read -$trunc_bytes; # print $fh $buffer; # seek $fh, 1, $trunc_bytes; # } # } # truncate $fh, tell $fh; # close $fh; # $files_done++; #} # #exit $files_done == 0; #### DO NOT USE #####
This should run at least a bit faster than your version since it doesn't concern itself with end-of-lines at all. Depending on how smart Tie::File is, it may be a whole lot faster - though as far as I know Dominus put some effort into making it clever. Still, you need no module for this of all tasks..

Makeshifts last the longest.

Replies are listed 'Best First'.
Re: Re: head truncate
by sauoq (Abbot) on Sep 13, 2002 at 01:00 UTC
    Untested, but no glaring mistakes obvious to me. If you see any, yell at me.

    You need @ARGV > 1 because > 2 will fail for the minimum of two args.

    Your WHENCE arguments to your seeks are all second instead of third where they belong.

    As long as that inner while loop is entered, that last truncate() will always occur immediately after your read fails. Which means you will be at the end of the file and, since you truncate from tell() to the end, you won't truncate anything.

    Update: Here is mine. It's based on yours but I've fixed the errors and simplified it a bit (as far as functionality goes.) I also introduce the $total_in variable to make the math a little clearer. Addendum: Aristotle found a bug in this code which surfaces when the last read is exactly BLOCKSIZE bytes long. See his reply and my reply to his reply for two different fixes.

    #!/usr/bin/perl -w use strict; use constant BLOCKSIZE => 128 * 1024; die "Usage: $0 numbytes file" unless @ARGV > 1; my $remove_bytes = shift @ARGV; my $file = shift @ARGV; open(my $fh, "+<", $file) or die "Couldn't open $file: $!\n"; if(-s $fh > $remove_bytes ) { seek $fh, $remove_bytes, 0; my $total_in = 0; while(my $bytes_in = read $fh, my $buf, BLOCKSIZE) { seek $fh, $total_in, 0; print $fh $buf; last if $bytes_in < BLOCKSIZE; $total_in += $bytes_in; seek $fh, $remove_bytes + $total_in, 0; } } truncate $fh, tell $fh;
    -sauoq
    "My two cents aren't worth a dime.";
    

      Yikes! In fact there are more bugs and more severe bugs in mine than you point out.

      That the die was of course meant to have an if and not an unless clause, is only a minor problem. The seeks are cosmetics too - shame on me.

      But the "late truncate" was a nasty thinko indeed. Unfortunately your fix of testing the read length against the block size won't work correctly either, since it fails when the last read gets exactly BLOCKSIZE bytes directly before the end of the file.

      The cool thing about the real fix is I got rid of the if that was bothering me before. I had a gut feeling that a correct solution should not require extra tests for small files that get truncated to zero and indeed, it doesn't.

      #!/usr/bin/perl -w use strict; #deletes first numbytes of a file use constant BLOCKSIZE => 128*1024; die "Usage: $0 numbytes file [file ...]\n" if @ARGV < 2; my $trunc_bytes = shift @ARGV; my $files_done = 0; for(@ARGV) { my $fh; unless(open $fh, "+<", $_) { warn "Couldn't open $_: $!\n"; next; } my $filesize = -s $fh; while($filesize > $trunc_bytes + tell $fh) { seek $fh, $trunc_bytes, 1; my $bytes_read = read($fh, my $buffer, BLOCKSIZE); seek $fh, -$bytes_read -$trunc_bytes, 1; print $fh $buffer; } truncate $fh, tell $fh; close $fh; $files_done++; } exit ($files_done == 0);

      I left my old code in place for comparisons.

      Update: added a couple brackets and changed open(..) or .. into unless(open ..) {..}.

      Update 2: pulled my $fh out of the open.

      Makeshifts last the longest.

        Much improved.

        I think exit $files_done == 0; is equivalent to exit($files_done) == 0 rather than exit ($files_done == 0) which is what you want.

        Also, ... or (warn "Couldn't open $_: $!\n", next); won't work as expected. You want ... or warn("Couldn't open $_: $!\n"), next; there. That one caught me off guard. I didn't catch it till I ran it.

        When I ran it (5.6.1), I also got this warning: Parentheses missing around "my" list at ./htr_a2 line 17. Line 17 is your read. Throwing parens around read's args eliminates the warning.

        I fixed the error you pointed out by using eof() and reintroduced the same functionality you had. I also added a check to be sure the first argument is numeric and positive.

        #!/usr/bin/perl -w use strict; use constant BLOCKSIZE => 128 * 1024; my $USAGE =<<END_OF_USAGE; Usage: $0 nbytes file [file ...] nbytes Positive integer. Number of bytes to remove. file Name(s) of file(s) to decapitate. END_OF_USAGE die $USAGE if @ARGV < 2; my $nbytes = shift @ARGV; die $USAGE unless $nbytes eq int(0+$nbytes) and $nbytes >= 0; my $completed = 0; for my $file (@ARGV) { open(my $fh, "+<", $file) or warn("Couldn't open $file: $!\n"),nex +t; if(-s $fh > $nbytes ) { seek $fh, $nbytes, 0; my $total_in = 0; while(my $bytes_in = read $fh, my $buf, BLOCKSIZE) { my $eof = eof($fh); seek $fh, $total_in, 0; print $fh $buf; $total_in += $bytes_in; last if $eof; seek $fh, $nbytes + $total_in, 0; } } truncate $fh, tell $fh; close $fh; $completed++; } exit ($completed == 0);
        -sauoq
        "My two cents aren't worth a dime.";