Destructive Split

[turnstep]

Category:

File Utilitties

Description:

This is a powerful variation on the unix program 'split' which breaks a file down into smaller chunks. This version destroys the original as it goes: the main use is for very large files which are too large to split normally, as the disk space will run out. Be very, very careful with this because it WILL DESTROY your original file.

#!/usr/bin/perl

use strict;
use POSIX qw(tmpnam);

my $file = shift or die "Usage: $0 filename <filesize>\n";

my $filesize  = shift || 100000;

open(F, "+<$file") or die "Could not open $file: $!\n";

my @files;
my $outfile = "aaaa";

{

  open(OUTFILE, ">$outfile") or die "Could not write $outfile: $!\n";
  select((select(OUTFILE),$|++)[0]);

  my $C;
  sysseek(F,-$filesize,2) or sysseek(F,0,0);
  sysread(F,$C,$filesize); ## should check return value...
  sysseek(F,-$filesize,2) or sysseek(F,0,0);
  truncate(F,sysseek(F,0,1));
  print OUTFILE $C;
  close(OUTFILE);
  unshift(@files, $outfile);

  last unless -s $file;

  ## We need a new filename
  {
    my $x = 1;
    1 while substr($outfile,-$x++,1) eq "z";
    if (--$x > length $outfile) { $outfile = tmpnam(); }
    else {
      substr($outfile,-$x--,1)++;
      substr($outfile,-$x--,1) = "a" while $x;
    }
    redo if -e $outfile;
  }

  redo;
}

my $files = @files;
print "Files created: $files\n";

if ($files>1) {
  my $meow = tmpnam();
  select(CATS) if open(CATS, ">$meow");
  print "cat ", join(" ", @files), " > $file\n";
  print STDOUT "Re-create with $meow\n";
}