http://www.perlmonks.org/index.pl?node_id=197300

Description: Someone asked in comp.unix.programmer how to truncate n bytes from the front of a file. Also the file couldn't be copied to a temp file. I came up with the following. Blast away fellow monks, that is the only way I learn. :-) 
#!/usr/bin/perl
use strict;
use Tie::File;
#deletes first nbytes of a file 

die "Usage: $0 file numbytes\n" unless @ARGV == 2;
my ($file, $nbytes) = @ARGV;
my $ncount=0;
my $line;

tie my @raw_data, 'Tie::File', $file , autochomp => 0 or die "Cannot O
+pen $file: $!";

while (1){
        $line = shift @raw_data;
         while($line){
                $line = substr ($line,1);
                $ncount++;
                if($ncount >= $nbytes ){last}
        }

if ($ncount >= $nbytes ){last;}
}

unshift @raw_data,$line;
untie @raw_data;
exit 0;
comment on head truncate
Download Code
Re: head truncate
by Aristotle on Sep 12, 2002 at 18:49 UTC
    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.

 [reply]
d/l code
      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.";
 [reply]
d/l code

        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.

 [reply]
d/l code
          Some notes below your chosen depth have not been shown here
Re: head truncate
by zentara on Sep 12, 2002 at 20:18 UTC
    Thanks for showing your attempt with seek. I got some sort of error running it, I will get back with you. I changed my code to use substr ($line,1) to lop off chars. My original way with chop $line was taking it off the end of the line, whereas a truncate from the front of the file, should be pulling the bytes off of the left of the string.
 [reply]
Re: head truncate
by zentara on Sep 12, 2002 at 20:36 UTC
    Aristotle, I tried your method and it dosn't work right. I start with basics, like just remove 1 byte and see what happens. So if I use your script like: scriptname 1 file somefile it increases the file size, and dosn't remove the first byte of the first line. I originally tried a similar method before using the Tie::File approach. I ran into a similar problem, when trying to truncate the filehandle to 0, then writing the filehandle again with the file remains, it somehow just adds it to the end. It stymied me.
 [reply]

Back to Snippets Section