home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / bin / dirsplit < prev    next >
Encoding:
Text File  |  2006-08-17  |  16.8 KB  |  568 lines
  1. #!/usr/bin/perl
  2. #                              -*- Mode: Perl -*-
  3. # dirsplit ---
  4. # Author           : Eduard Bloch ( blade@debian.org )
  5. # Last Modified On : Sun, 06 Feb 2005 14:59:51 +0100
  6. # Status           : Working, but use with caution!
  7. # License: GPLv2
  8.  
  9. my $version="0.3.1";
  10.  
  11. require v5.8.1;
  12. use strict;
  13. use List::Util 'shuffle';
  14. use Getopt::Long qw(:config no_ignore_case bundling);
  15. use File::Basename;
  16. use Cwd 'abs_path';
  17.  
  18. my $ret=0;
  19. my $max="4488M";
  20. my $prefix="vol_";
  21. my $acc=500;
  22. my $emode=1;
  23. my $bsize=2048;
  24. my $ofac =50;
  25. my $opt_help;
  26. my $opt_longhelp;
  27. my $opt_sim;
  28. my $opt_dir;
  29. my $opt_flat;
  30. my $opt_cor;
  31. my $opt_move;
  32. my $opt_ver;
  33. my $opt_sln;
  34. my $opt_ln;
  35. my $opt_filter;
  36.  
  37. my $get_ver;
  38.  
  39. my $msg="
  40. dirsplit [options] [advanced options] (directory|content-list-file)
  41.  
  42.  -H|--longhelp Show the long help message with more advanced options
  43.  -n|--no-act   Only print the commands, no action (implies -v)
  44.  -s|--size     NUMBER - Size of the medium (default: $max)
  45.  -e|--expmode  NUMBER - directory exploration mode (recommended, see long help)
  46.  -m|--move     Move files to target dirs (default: create mkisofs catalogs)
  47.  -f|--flatdir  Flat dir mode, don't recreate directory structure
  48.  -p|--prefix   STRING - first part of catalog/directory name (default: vol_)
  49.  -c|--correct  Remove directory space summaries, eg. from du output
  50.  -h|--help     Show this option summary
  51.  -v|--verbose  More verbosity
  52.                    
  53. The complete help can be displayed with the --longhelp (-H) option.
  54. The default mode is creating file catalogs useable with:
  55.     mkisofs -D -r --joliet-long -graft-points -path-list CATALOG
  56.  
  57. Example:
  58. dirsplit -m -s 700M -e4 random_data_to_backup/
  59. ";
  60.  
  61. my $msglong="
  62. dirsplit [options] [advanced options] < directory | content-list-file >
  63.  -n|--no-act   Only print the commands, no action (implies -v)
  64.  -s|--size     NUMBER - Size of the medium (default: $max)
  65.  -m|--move     Move files to target dirs (default: create mkisofs catalogs)
  66.  -l|--symlink  similar to -m but just creates symlinks in the target dirs
  67.  -L|--hardlink like -l but creates hardlinks
  68.  -p|--prefix   STRING - first part of catalog/directory name (default: vol_)
  69.  -f|--filter   EXPR - Filter expression, see examples below and perlre manpage
  70.  --flat        Flat dir mode, don't recreate subdirectory structure (not recommended)
  71.  -e|--expmode  NUMBER, special exploration modes, used with directory argument
  72.  
  73.   0: dumb file search with \"du -a\", file sizes are rounded up by du, every file treated as object. Slightly till very inaccurate, dependending on filesystem types and mkisofs options.
  74.   1: (default) native exploration of the specified directory, but file sizes are rounded up to 2048 blocks plus estimated overhead for filenames (see -o option)
  75.   2: like 1, but when single files _and_ directory found in the same directory somewhere, the files are treated as one object
  76.   3: like 2, but don't coalesc when the size of the virtual object becomes too large for a medium size (currently $max)
  77.   4: like 2, but the max. size of the virtual object built on files is limited to $max (create another after max. size)
  78.  
  79.  -b|--blksize  NUMBER, block size of the target filesystem (currently $bsize). Works in exploration mode.
  80.  -o|--overhead NUMBER, overhead caused by directory entries (as factor for the filename length, default: 50, empiricaly found for Joliet+RR with not-so-deep directory structure). Works in exploration mode.
  81.  -a|--accuracy NUMBER (1=faster, large number=better efficiency, default: 500)
  82.  -c|--correct  Fix input data when it comes from du (KiB expansion, dupes/summaries removal)
  83.  -h|--help     Show this option summary
  84.  -v|--verbose  More verbosity
  85.                    
  86. The content list may be read from a file or from standard input (use -)
  87. and contain lines with file sizes and file/directory names. File sizes
  88. are expected to be in KiB, append modifier letters to recalculate them,
  89. b for bytes, m for megabytes (10^6) or mebibytes (2^10). The default
  90. mode is creating file catalogs useable with
  91.     mkisofs -D -r --joliet-long -graft-points -path-list CATALOG
  92.  
  93. Examples:
  94. dirsplit -m -s 120M -e4 largedirwithdata/ -p /zipmedia/backup_   #move stuff into splitted backup dirs
  95. dirsplit -s 700M -e2 music/ # make mkisofs catalogs to burn all music to 700M CDRs, keep single files in each dir together
  96. dirsplit -s 700M -e2 -f '/other\\/Soundtracks/' music/ # like above, only take files from other/Soundtracks
  97. dirsplit -s 700M -e2 -f '!/Thumbs.db|Desktop.ini|\\.m3u\$/i' # like above, ignore some junk files and playlists, both letter cases
  98.  
  99. (old method:)
  100. du -s mp3/Collections/Rock/* mp3/Singles/Pop/* | dirsplit -s 701M -
  101.  
  102. You should compare the required size of the created catalogs, as in_
  103. for x in *list ; do mkisofs -quiet -D -r --joliet-long -graft-points -path-list \$x -print-size; done
  104. with the media data (cdrecord -v -toc ...). dirsplit calculates very sharp but
  105. without knowing the result in advance, so unexpected deep directory structures
  106. may create additional overhead. Make sure you have some reserve capacity when
  107. specifying the max media size.
  108. ";
  109.  
  110. my %options = (
  111.    "h|help"                => \$opt_help,
  112.    "d|dirhier"            => \$opt_dir,
  113.    "flat"            => \$opt_flat,
  114.    "f|filter=s"            => \$opt_filter,
  115.    "e|expmode=i"            => \$emode,
  116.    "o|overhead=i"            => \$ofac,
  117.    "b|blksize=i"            => \$bsize,
  118.    "n|no-act"            => \$opt_sim,
  119.    "m|move"            => \$opt_move,
  120.    "l|symlink"            => \$opt_sln,
  121.    "L|hardlink"           => \$opt_ln,
  122.    "v|verbose"            => \$opt_ver,
  123.    "s|size=s"             => \$max,
  124.    "p|prefix=s"              => \$prefix,
  125.    "c|correct"               => \$opt_cor,
  126.    "a|accuracy=i"            => \$acc,
  127.    "H|longhelp"            => \$opt_longhelp,
  128.    "version"                 => \$get_ver
  129. );
  130.  
  131. die $msg unless ( GetOptions(%options));
  132. if($opt_help) {
  133.    print $msg;
  134.    exit 0;
  135. }
  136. if($opt_longhelp) {
  137.    print $msglong;
  138.    exit 0;
  139. }
  140. if($get_ver) {
  141.    print $version;
  142.    exit 0;
  143. }
  144.  
  145. # ignore the old dirhier setting since it is default now and disable the flag when opt_flat is specified
  146. $opt_dir = !$opt_flat;
  147.  
  148. $opt_ver = 1 if $opt_sim;
  149. $opt_move=1 if ($opt_sln || $opt_ln);
  150.  
  151. sub fixnr {
  152.    # args: 
  153.    # Number
  154.    # optional: default multiplier
  155.    my $fac;
  156.    my $nr;
  157.    if($_[0]=~/(\d+)(\D)/) {
  158.       $nr=$1;
  159.       $fac=$2;
  160.    }
  161.    elsif(defined($_[1])) {
  162.       $nr=$_[0];
  163.       $fac=$_[1];
  164.    }
  165.    else {
  166.       return $_[0];
  167.    }
  168.    return $nr*1000000 if($fac eq "m");
  169.    return $nr*1048576 if($fac eq "M");
  170.    return $nr*1000 if($fac eq "k");
  171.    return $nr*1024 if($fac eq "K");
  172.    return $nr if($fac eq "b");
  173.    die "$fac is not a valid multiplier!";
  174. }
  175.  
  176. sub mkdirhier { 
  177.    return 1 if($_[0] eq ".");
  178.    return 1 if(-d $_[0] && -w $_[0]);
  179.    return 0 if !mkdirhier(dirname($_[0]));
  180.    return mkdir $_[0];
  181. }
  182.  
  183. my $l;
  184. my @in;
  185. my %names;
  186. my %coalesced; # this will contain arrays with coalesced files
  187.  
  188. # name to size
  189. my %ntos;
  190.  
  191. my @indata;
  192. my $inputdir;
  193.  
  194. $max=fixnr($max);
  195. # about 400kB for iso headers
  196. $max-=420000;
  197.  
  198. # parse du -s output
  199. if(-f $ARGV[0] || (-f readlink($ARGV[0])) || $ARGV[0] eq "-") {
  200.    die "Exploration mode argument is useless with pregenerated data, aborting...\n" if($emode);
  201.    open($l, "<".$ARGV[0]);
  202.    @indata=<$l>;
  203.    &parseduinput;
  204. }
  205. elsif(-d $ARGV[0] || (-d readlink($ARGV[0]))) {
  206.    if($emode) {
  207.       #die "not implemented yet";
  208.       $opt_cor=0;
  209.       $inputdir=Cwd::abs_path($ARGV[0]);
  210.       &explore($inputdir);
  211.    }
  212.    else {
  213.       $opt_cor=1;
  214.       @indata=`du -l -a $ARGV[0]/`;
  215.       &parseduinput;
  216.    }
  217. }
  218. else {
  219.    die "Directory or contents listing needed!\n";
  220. }
  221.  
  222. # recursive function
  223. # parameter: directory
  224. # mode 1: descend as far as possible and index all non-directories
  225. # mode 2++:
  226. # put all files of a dir into coaleseced-object, then descend into each dir
  227. sub explore {
  228.    (my $dir) = @_;
  229.    my @stuff;
  230.    my @dirs;
  231.    my @files;
  232.  
  233. #   print "D: $dir\n";
  234.    opendir(DIR, $dir) || die "Could not open $dir\n";
  235.    while (my $f = readdir(DIR)) {
  236.       next if ($f eq "." || $f eq "..");
  237.       #print "\$f=$opt_filter;\n";
  238.       
  239.       $f="$dir/$f" if($dir ne ".");
  240.  
  241.       if(-d $f && !-l $f) {
  242.          push(@dirs, $f);
  243.       }
  244.       else {
  245.          if ($opt_filter) {
  246. #            print "D:exp: \$f=$opt_filter;, Wert: ".eval("\$f=~$opt_filter;")."\n";
  247.             if(eval("\$f=~$opt_filter;")) {
  248. #            print "D: added $f\n";
  249.                push(@files, $f);
  250.             }
  251.       }
  252.          else {
  253. #            print "D: added $f\n";
  254.             push(@files, $f);
  255.          }
  256.       }
  257.    }
  258.    closedir(DIR);
  259.    #print "D: $dir fertig",@dirs;
  260.  
  261.    if($#dirs < 0 && $#files < 0) {
  262.       # this one is empty, register for cosmetics reason
  263.       return if ($opt_filter && !eval("\$dir=~$opt_filter;"));
  264.       $ntos{$dir}=getsize($dir);
  265.       return;
  266.    }
  267.    explore($_) for(@dirs);
  268.  
  269.    if($emode==1) {
  270.       $ntos{$_}=getsize($_) for(@files);
  271.    }
  272.    else {
  273.       my $filesum=0;
  274.       for(@files) {
  275.          my $tmp=getsize($_);
  276.          if($tmp>$max) {
  277.             # already too large, stop right here
  278.             die "Too large file ($_) for the given max size $max, aborting...\n";
  279.          }
  280.          $filesum += $tmp;
  281.       };
  282.       if($filesum>$max) {
  283.          # too large coal. object...
  284.          if($emode==3) {
  285.             # don't coalesc in this mode, leave them alone
  286.             $ntos{$_}=getsize($_) for(@files);
  287.             return;
  288.          }
  289.          if($emode==4) {
  290. #            print "D: mode 4!\n";
  291.             # a bit complicated, split file set into coal.objects
  292.             my $partsum=0;
  293.             my @sorted=sort(@files);
  294.             my @tmpvol;
  295.             for(my $i=0;$i<=$#sorted;$i++) {
  296. #            print "D: i: $i, partsum: $partsum, file: $sorted[$i]\n";
  297.                my $tmp=getsize($sorted[$i]);
  298.                $partsum+=$tmp;
  299.                if($partsum>$max) {
  300.                   # undo the last step then build the coal.object
  301.                   $partsum-=$tmp;
  302.                   $i--;
  303.  
  304. #                  print "D: coal: ".join(",", @tmpvol)."\n";
  305.                   my $iname = ("### Coalesced file object, placeholder for the directory $dir up to file $sorted[$i] ###"." "x256);
  306.                   @{$coalesced{$iname}} = @tmpvol;
  307.                   $ntos{$iname}=$partsum;
  308.                   # tmps reseten
  309.                   undef @tmpvol;
  310.                   undef $partsum;
  311.                }
  312.                else {
  313.                   push(@tmpvol, $sorted[$i]);
  314.                }
  315.             }
  316.             return;
  317.          }
  318.       }
  319.  
  320.       # be an invalid filename
  321.       if($filesum) {
  322.          my $iname = ("### Coalesced file object, placeholder for stuff in the directory $dir ###"." "x256);
  323.          @{$coalesced{$iname}} = @files;
  324.          $ntos{$iname}=$filesum;
  325.       }
  326.    }
  327. }
  328.  
  329. sub getsize {
  330.    (my $file) = @_;
  331.    my $size = ((stat($file))[7]);
  332.    my $rest = ($size % $bsize);
  333.    $size = ($size + $bsize - $rest) if ($rest);
  334.    return 1+int(200 + $ofac*length(basename($file)) + $size);
  335. }
  336.    
  337.  
  338. sub parseduinput {
  339.    for(@indata) {
  340.       chomp;
  341.       if(/^(\w+)\s+(.+)/ && $2 ne "./") {
  342.          #print "D: ntos $2 ist ".fixnr($1, "K")."\n";
  343.          $ntos{$2}=fixnr($1, "K");
  344.       }
  345.    }
  346. }
  347.  
  348. # sort and kill dupes/summaries
  349. if($opt_cor) {
  350.    my @intmp=sort(keys %ntos);
  351. #   die join("\n", @intmp, "");
  352.    my @newin;
  353.  
  354.    for(my $i=0;$i<=$#intmp;$i++) {
  355.       $_=$intmp[$i];
  356.       chomp;
  357.       # weed out directory summaries
  358.       # print "vgl. ". "$_/ ne substr(".$intmp[$i+1].",0,length($_)+1)) \n";
  359.       /.*(.)$/;
  360.       if ($1 ne "/" && "$_/" ne substr($intmp[$i+1],0,length($_)+1)) { 
  361.          # feed the final data holders
  362.          push(@in, $ntos{$_});
  363.          # linked list behind the hash entry
  364.          my $realname=$_;
  365.          $realname=~s!^\./!!;
  366.          push(@{$names{$ntos{$_}}}, $realname);
  367.       }
  368.    }
  369. }
  370. else {
  371.    # copy around
  372.    for(keys %ntos) {
  373. #      print "wtf, $_, $ntos{$_}\n";
  374.       push(@in, $ntos{$_});
  375.       # linked list behind the hash entry
  376.       push(@{$names{$ntos{$_}}}, $_);
  377.    }
  378. }
  379.  
  380. for(@in) {
  381.    die "Too large object(s) ($_) for the given max size: ".join(", ",
  382.    @{$names{$_}})."\n" if($_>$max);
  383. }
  384.  
  385. $a=0;
  386. for(@in) {$a+=$_};
  387. $acc=1 if ($a <= $max); # just generate a list, more trials are pointless
  388. print "\nSumm: $a\n" if($opt_ver);
  389. die "Nothing to do!\n" if($a<4096); # looks like just an empty dir
  390.  
  391. my $i;
  392. my @out;
  393.  
  394. # Parms: bin size (int), input array (arr reference), output array (arr reference)
  395. # Returns: wasted space (int)
  396. sub bp_bestfit {
  397.    my $max=$_[0];
  398.    my @in = @{$_[1]};
  399.    my $target = $_[2];
  400.    my @out;
  401.    my @bel;
  402.  
  403.    my @tmp;
  404.    push(@tmp,$in[0]);
  405.    push(@out, \@tmp);
  406.    $bel[0] = $in[0];
  407.    shift @in;
  408.  
  409.    for(@in) {
  410.       my $bestplace=$#out+1;
  411.       my $bestwert=$max;
  412.       for($i=0;$i<=$#out;$i++) {
  413.          my $rest;
  414.          $rest=$max-$bel[$i]-$_;
  415.          if($rest>0 && $rest < $bestwert) {
  416.             $bestplace=$i;
  417.             $bestwert=$rest;
  418.          };
  419.       }
  420.       if($bestplace>$#out) {
  421.          my @bin;
  422.          $bel[$bestplace]=$_;
  423.          push(@bin, $_);
  424.          push(@out,\@bin);
  425.       }
  426.       else{
  427.          $bel[$bestplace]+=$_;
  428.          push(  @{$out[$bestplace]}    , $_);
  429.       }
  430.    }
  431.    my $ret=0;
  432.    # count all rests but the last one
  433.    for($i=0;$i<$#out;$i++) {
  434.       $ret+=($max-$bel[$i]);
  435.    }
  436.    @{$target} = @out;
  437.    return $ret;
  438. }
  439.  
  440. # Parms: bin size (int), input array (arr reference), output array (arr reference)
  441. # Returns: wasted space (int)
  442. sub bp_firstfit {
  443.    my $max=$_[0];
  444.    my @in = @{$_[1]};
  445.    my $target = $_[2];
  446.    my @out;
  447.    my @bel;
  448.  
  449.    piece: foreach my $obj (@in) {
  450.       # first fit, use the first bin with enough free space
  451.       for($i=0;$i<=$#out;$i++) {
  452.          my $newsize=($bel[$i]+$obj);
  453. #         print $bel[$i]."\n";
  454.          if( $newsize <= $max ) {
  455. #            print "F: bin$i: $bel[$i]+$obj=$newsize\n";
  456.             #fits here
  457.             $bel[$i]=$newsize;
  458.             push(  @{$out[$i]} , $obj);
  459.             next piece; # break
  460.          }
  461.       }
  462.       # neues Bin
  463.       my @bin;
  464.       $bel[$i]=$obj;
  465. #      print "N: bin$i: $bel[$i]=$obj\n";
  466.       push(@bin, $obj);
  467.       push(@out,\@bin);
  468.    }
  469.    my $ret=0;
  470.    # sum up all rests except of the one from the last bin
  471.    for($i=0;$i<$#out;$i++) {
  472. #           print "hm, bel $i ist :".$bel[$i]." und res:".($max-$bel[$i])."\n";
  473.       $ret+=($max-$bel[$i]);
  474.    }
  475.    @{$target} = @out;
  476. #      print "wtf, ".join(",", @{$out[0]})."\n";
  477.    return $ret;
  478. }
  479.  
  480. my @erg;
  481. my $globwaste=$max*($#in+1);
  482. my $starttime=time;
  483. for(1..$acc) {
  484.    syswrite(STDOUT,".");
  485.    my @tmp;
  486.    #my $waste = bp_bestfit($max, \@in, \@tmp);
  487.    my $waste = bp_firstfit($max, \@in, \@tmp);
  488.    #print "D: waste - $waste\n";
  489.    @in=shuffle(@in);
  490.    if($waste < $globwaste) {
  491.       $globwaste=$waste;
  492.       @erg=@tmp;
  493.    }
  494.    if($starttime && time > $starttime+10) {
  495.       syswrite(STDOUT,"\nSpent already over 10s (for $_ iterations)\nHint: reduce accuracy to make it faster!\n");
  496.       undef $starttime;
  497.    }
  498. }
  499. print "\nCalculated, using ".($#erg+1)." volumes.\n";
  500.    
  501. print "Wasted: $globwaste Byte (estimated, check mkisofs -print-size ...)\n";
  502.  
  503. # and the real work
  504. $i=1;
  505. my $inDirLen=length($inputdir);
  506. for(@erg) {
  507.    my $o;
  508.    open($o, ">$prefix$i.list") if(! ($opt_move | $opt_sim));
  509.    for(@{$_}) {
  510.       my @stuff;
  511.       my $object=shift(@{$names{$_}});
  512.       if(-e $object) {
  513.          @stuff=($object);
  514.       }
  515.       elsif(defined $coalesced{$object}) {
  516.          @stuff=@{$coalesced{$object}};
  517.       }
  518.       else {
  519.          print "Warning, $object not found, skipping...\n";
  520.          $ret=1;
  521.       }
  522.       my $dirPrefix=dirname($prefix);
  523.       my $prefixBase=basename($prefix);
  524.       my $dirPrefixAbs=Cwd::abs_path($dirPrefix);
  525.       for my $file (@stuff) {
  526.          my $relFile=substr($file,$inDirLen+1);
  527.          my $base=basename($relFile);
  528.          if($opt_move) {
  529.             my $targetsubdir = $dirPrefixAbs."/$prefixBase$i";
  530.             $targetsubdir .= "/".dirname($relFile) if($opt_dir);
  531.             print "$file -> $targetsubdir/$base\n" if($opt_ver);
  532.             if(!$opt_sim) {
  533.                mkdirhier $targetsubdir || die "Problems creating $targetsubdir\n";
  534.                # last check
  535.                die "Could not create $targetsubdir?\n" if(!(-d $targetsubdir && -w $targetsubdir));
  536.                if($opt_sln) {
  537.                   symlink($file, "$targetsubdir/$base");
  538.                }
  539.                elsif($opt_ln) {
  540.                   if(-d $file && !-l $file) {
  541.                      mkdir "$targetsubdir/$base";
  542.                   }
  543.                   else {
  544.                      link($file, "$targetsubdir/$base");
  545.                   }
  546.                }
  547.                else {
  548.                   rename($file, "$targetsubdir/$base");
  549.                }
  550.             }
  551.          }
  552.          else {
  553.             # escape = in mkisofs catalogs, they are used as separator
  554.             my $isoname = ($opt_dir?$relFile : $base);
  555.             $isoname=~s/=/\\=/g;
  556.             my $sourcefile=$file;
  557.             $sourcefile=~s/=/\\=/g;
  558.             print "$i: /$isoname=$sourcefile\n" if $opt_ver;
  559.             print $o "/$isoname=$sourcefile\n" if(!$opt_sim);
  560.          }
  561.       }
  562.    }
  563.    $i++;
  564.    close($o) if($o);
  565. }
  566.  
  567. exit $ret;
  568.