3rd-party/dirsplit/dirsplit

   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.3";
  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 File::Path;
  17 use Cwd 'abs_path';
  18
  19 my $ret=0;
  20 my $max="4488M";
  21 my $prefix="vol_";
  22 my $acc=20;
  23 my $emode=1;
  24 my $bsize=2048;
  25 my $ofac =50;
  26 my $opt_help;
  27 my $opt_longhelp;
  28 my $opt_sim;
  29 my $opt_dir;
  30 my $opt_flat;
  31 my $opt_move;
  32 my $opt_ver;
  33 my $opt_sln;
  34 my $opt_ln;
  35 my $opt_filter;
  36 my $opt_simple;
  37 my $opt_follow;
  38 my $get_ver;
  39 my $opt_listfile;
  40
  41
  42 my %options = (
  43    "h|help"                => \$opt_help,
  44    "d|dirhier"            => \$opt_dir,
  45    "flat"            => \$opt_flat,
  46    "f|filter=s"            => \$opt_filter,
  47    "F|follow"            => \$opt_follow,
  48    "e|expmode=i"            => \$emode,
  49    "o|overhead=i"            => \$ofac,
  50    "b|blksize=i"            => \$bsize,
  51    "n|no-act"            => \$opt_sim,
  52    "m|move"            => \$opt_move,
  53    "l|symlink"            => \$opt_sln,
  54    "L|hardlink"           => \$opt_ln,
  55    "v|verbose"            => \$opt_ver,
  56    "s|size=s"             => \$max,
  57    "S|simple"             => \$opt_simple,
  58    "T|input=s"       => \$opt_listfile,
  59    "p|prefix=s"              => \$prefix,
  60    "a|accuracy=i"            => \$acc,
  61    "H|longhelp"            => \$opt_longhelp,
  62    "version"                 => \$get_ver
  63 );
  64
  65 &show_help(1) unless ( GetOptions(%options));
  66 &show_help(1) if $opt_help;
  67 &show_longhelp if $opt_longhelp;
  68 if($get_ver) {
  69    print $version;
  70    exit 0;
  71 }
  72
  73 # ignore the old dirhier setting since it is default now and disable the flag when opt_flat is specified
  74 $opt_dir = !$opt_flat;
  75
  76 $opt_ver = 1 if $opt_sim;
  77 $opt_move=1 if ($opt_sln || $opt_ln);
  78
  79 # big list @sizes containing the "items" (object sizes)
  80 # %names hash mapping "items" (size as key) to arrays with filenames/subarrays for coalesced files
  81 my @sizes;
  82 my %names;
  83
  84 # result containts the calculated output. In simple mode, an
  85 # array (bins) of atoms (files or filelists). Otherwise, sizes
  86 # instead of atoms, to be resolved with %names.
  87 my @result;
  88
  89 my $inputdir;
  90
  91 $max=fixnr($max);
  92 # about 400kB for iso headers
  93 $max-=420000;
  94
  95 # init default value
  96 my $globwaste=0;
  97
  98
  99 if(-d $ARGV[0] || (-d readlink($ARGV[0]))) {
 100    syswrite(STDOUT,"Building file list, please wait...\n");
 101    # save the absolut path before doing anyhting
 102    $inputdir=Cwd::abs_path($ARGV[0]);
 103    &explore($inputdir);
 104 }
 105 elsif($opt_listfile) {
 106    if($opt_listfile eq "-") {
 107       &parseListe(\*STDIN);
 108    }
 109    else {
 110       open(my $in, "<", $opt_listfile) || die "Cannot open list file $opt_listfile\n";
 111       &parseListe($in);
 112    }
 113 }
 114 else {
 115    die "Error: please specify a directory\n";
 116 }
 117
 118 # check for pointless requests
 119 my $testsize=0;
 120 for(@sizes) {
 121    die "Too large object(s) ($_) for the given max size: @{$names{$_}} (maybe coalesced in arrays, check manually)\n" if($_>$max);
 122
 123    $testsize+=$_;
 124 }
 125
 126 $acc=1 if ($testsize <= $max); # just generate a list, more trials are pointless
 127 print "\nSumm: $testsize\n" if($opt_ver);
 128 die "Nothing to do!\n" if($testsize<4096); # looks like just an empty dir
 129
 130 if(!$opt_simple) {
 131    syswrite(STDOUT, "Calculating, please wait...\n");
 132    my $starttime=time;
 133    $globwaste=$max*@sizes;
 134    for(1..$acc) {
 135       syswrite(STDOUT,".");
 136       my @tmp;
 137       #my $waste = bp_bestfit($max, \@in, \@tmp);
 138       my $waste = bp_firstfit($max, \@sizes, \@tmp);
 139       #print "D: waste - $waste\n";
 140       if($waste < $globwaste) {
 141          $globwaste=$waste;
 142          @result=@tmp;
 143       }
 144       if($starttime && time > $starttime+10) {
 145          syswrite(STDOUT,"\nSpent already over 10s (for $_ iterations)\nHint: reduce accuracy to make it faster!\n");
 146          undef $starttime;
 147       }
 148       @sizes=shuffle(@sizes);
 149    }
 150
 151 }
 152
 153 print "\nCalculated, using ".(scalar @result)." volumes.\n";
 154 print "Wasted: $globwaste Byte (estimated, check mkisofs -print-size ...)\n";
 155
 156 # and the real work
 157 my $i=0;
 158 my $inDirLen=length($inputdir);
 159 for(@result) {
 160    $i++;
 161    my $o;
 162    open($o, ">$prefix$i.list") if(! ($opt_move || $opt_sim));
 163    my $dirPrefix=dirname($prefix);
 164    my $prefixBase=basename($prefix);
 165    my $dirPrefixAbs=Cwd::abs_path($dirPrefix);
 166
 167    for(@{$_}) {
 168       my $stuffRef;
 169
 170       # For simple mode, the files/atoms are already resolved, otherwise take
 171       # the next with appropriate size.
 172       my $item= $opt_simple ? $_ : shift(@{$names{$_}});
 173
 174       # make reference point to an array with our files, create a list if needed
 175       if(ref($item) eq "ARRAY") {
 176          $stuffRef=$item;
 177       }
 178       else {
 179          $stuffRef=[$item];
 180       }
 181
 182       for my $file (@$stuffRef) {
 183          my $relFile=substr($file,$inDirLen+1);
 184          my $base=basename($relFile);
 185          if($opt_move) {
 186             my $targetsubdir = $dirPrefixAbs."/$prefixBase$i";
 187             $targetsubdir .= "/".dirname($relFile) if($opt_dir);
 188             print "$file -> $targetsubdir/$base\n" if($opt_ver);
 189             if(!$opt_sim) {
 190                mkpath $targetsubdir || die "Problems creating $targetsubdir\n";
 191                # last check
 192                die "Could not create $targetsubdir?\n" if(!(-d $targetsubdir && -w $targetsubdir));
 193                if($opt_sln) {
 194                   symlink($file, "$targetsubdir/$base");
 195                }
 196                elsif($opt_ln) {
 197                   if(-d $file && !-l $file) {
 198                      mkdir "$targetsubdir/$base";
 199                   }
 200                   else {
 201                      link($file, "$targetsubdir/$base");
 202                   }
 203                }
 204                else {
 205                   rename($file, "$targetsubdir/$base");
 206                }
 207             }
 208          }
 209          else {
 210             # escape = in mkisofs catalogs, they are used as separator
 211             my $isoname = ($opt_dir?$relFile : $base);
 212             $isoname=~s/=/\\=/g;
 213             my $sourcefile=$file;
 214             $sourcefile=~s/=/\\=/g;
 215             print "$i: /$isoname=$sourcefile\n" if $opt_ver;
 216             print $o "/$isoname=$sourcefile\n" if(!$opt_sim);
 217          }
 218       }
 219    }
 220    close($o) if($o);
 221 }
 222
 223 exit $ret;
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263 # recursive function
 264 # parameter: directory
 265 # mode 1: descend as far as possible and index all non-directories
 266 # mode 2++:
 267 # put all files of a dir into coaleseced-object, then descend into each dir
 268 sub explore {
 269    (my $dir) = @_;
 270    my @stuff;
 271    my @dirs;
 272    my @files;
 273
 274    opendir(DIR, $dir) || die "Could not open $dir\n";
 275    @stuff=readdir(DIR);
 276
 277    if($opt_simple) {
 278       @stuff=sort { lc($a) cmp lc($b) } @stuff;
 279    }
 280
 281    foreach my $f (@stuff) {
 282       next if ($f eq "." || $f eq "..");
 283       #print "\$f=$opt_filter;\n";
 284
 285       $f="$dir/$f" if($dir ne ".");
 286
 287       if ($opt_filter) {
 288          next unless (eval("\$f=~$opt_filter;"));
 289       }
 290
 291       if(-l $f && ! $opt_follow) {
 292          push(@files, $f);
 293       }
 294       elsif(-d $f) {
 295          push(@dirs, $f);
 296       }
 297       else {
 298          push(@files, $f);
 299       }
 300    }
 301    closedir(DIR);
 302
 303    if( (@dirs + @files) == 0 ) {
 304       # this one is empty, register for cosmetics reason
 305       &insitem(getsize($dir), $dir);
 306       return;
 307    }
 308
 309    # recurse on directories
 310    &explore($_) for(@dirs);
 311
 312    # and now process files
 313    if($emode==1) {
 314       &insitem(getsize($_), $_) for(@files);
 315    }
 316    else {
 317       # handle coalesced objects - first some sanity checks and splitting if
 318       # required
 319
 320       my $filesum=0;
 321       for(@files) {
 322          my $tmp=getsize($_);
 323          if($tmp>$max) {
 324             # already too large, stop right here
 325             die "Too large file ($_) for the given max size $max, aborting...\n";
 326          }
 327          $filesum += $tmp;
 328       };
 329
 330       # handle coal. objects becoming too large
 331       if($filesum>$max) {
 332          # too large coal. object...
 333          if($emode==3) {
 334             # don't coalesc in this mode, do like mode 1 above, leave them alone
 335             &insitem(getsize($_), $_) for(@files);
 336             return;
 337          }
 338          # a bit complicated, split file set while creating coal.objects
 339          if($emode==4) {
 340             my $partsum=0;
 341             my @sorted=sort(@files);
 342             my @tmpvol;
 343             for(my $i=0;$i<=$#sorted;$i++) {
 344 #            print "D: i: $i, partsum: $partsum, file: $sorted[$i]\n";
 345                my $tmp=getsize($sorted[$i]);
 346                $partsum+=$tmp;
 347                if($partsum>$max) {
 348                   # undo the last step then build the coal.object
 349                   $partsum-=$tmp;
 350                   $i--;
 351
 352                   &insitem($partsum, \@tmpvol);
 353                   # reset temporaries
 354                   undef @tmpvol;
 355                   undef $partsum;
 356                }
 357                else {
 358                   push(@tmpvol, $sorted[$i]);
 359                }
 360             }
 361             return;
 362          }
 363       }
 364
 365       # ok, building a coalesced object for simple cases
 366       if($filesum) {
 367          &insitem($filesum, \@files);
 368       }
 369    }
 370 }
 371
 372 my $simplePos=0;
 373 my @simpleBinSizes;
 374
 375 # args: size, object (filename or list reference)
 376 sub insitem {
 377    my ($size, $object) = @_;
 378    # normaly, put the items into the pool for calculation. In simple mode, calculate here
 379
 380    push(@sizes, $size);
 381    push(@{$names{$size}},$object);
 382
 383    if($opt_simple) {
 384       # now the simplest method to fill the bins, just take a new one when the
 385       # object-to-be-added no longer fits
 386       if($simpleBinSizes[$simplePos]+$size > $max) {
 387          $globwaste += ( $max-$simpleBinSizes[$simplePos] );
 388          $simplePos++;
 389       };
 390       $simpleBinSizes[$simplePos]+=$size;
 391       push( @{$result[$simplePos]}, $object);
 392    }
 393
 394 }
 395
 396 sub getsize {
 397    (my $file) = @_;
 398    my $size = ((stat($file))[7]);
 399    my $rest = ($size % $bsize);
 400    $size = ($size + $bsize - $rest) if ($rest);
 401    return 1+int(200 + $ofac*length(basename($file)) + $size);
 402 }
 403
 404 sub parseListe {
 405    my $fh=${$_[0]};
 406    while(<$fh>) {
 407       if(/^(\w+)\s+(.+)/) {
 408          &insitem(fixnr($1), $2);
 409       }
 410    }
 411 }
 412
 413 sub fixnr {
 414    # args:
 415    # Number
 416    # optional: default multiplier
 417    my $fac;
 418    my $nr;
 419    if($_[0]=~/(\d+)(\D)/) {
 420       $nr=$1;
 421       $fac=$2;
 422    }
 423    elsif(defined($_[1])) {
 424       $nr=$_[0];
 425       $fac=$_[1];
 426    }
 427    else {
 428       return $_[0];
 429    }
 430    return $nr*1000000000 if($fac eq "g");
 431    return $nr*1073741824 if($fac eq "G");
 432    return $nr*1000000 if($fac eq "m");
 433    return $nr*1048576 if($fac eq "M");
 434    return $nr*1000 if($fac eq "k");
 435    return $nr*1024 if($fac eq "K");
 436    return $nr if($fac eq "b");
 437    die "$fac is not a valid multiplier!";
 438 }
 439
 440
 441 sub show_help {
 442    print <<EOM
 443 dirsplit [options] [advanced options] < directory >
 444
 445  -H|--longhelp Show the long help message with more advanced options
 446  -n|--no-act   Only print the commands, no action (implies -v)
 447  -s|--size     NUMBER - Size of the medium (default: $max)
 448  -e|--expmode  NUMBER - directory exploration mode (recommended, see long help)
 449  -m|--move     Move files to target dirs (default: create mkisofs catalogs)
 450  -p|--prefix   STRING - first part of catalog/directory name (default: vol_)
 451  -h|--help     Show this option summary
 452  -v|--verbose  More verbosity
 453
 454 The complete help can be displayed with the --longhelp (-H) option.
 455 The default mode is creating file catalogs useable with:
 456     mkisofs -D -r --joliet-long -graft-points -path-list CATALOG
 457
 458 Example:
 459 dirsplit -m -s 700M -e2 random_data_to_backup/
 460 EOM
 461    ;
 462    exit shift;
 463 }
 464
 465 sub show_longhelp {
 466    my $msglong="
 467 dirsplit [options] [advanced options] < directory >
 468  -n|--no-act   Only print the commands, no action (implies -v)
 469  -s|--size     NUMBER - Size of the medium (default: $max)
 470  -m|--move     Move files to target dirs (default: create mkisofs catalogs)
 471  -l|--symlink  similar to -m but just creates symlinks in the target dirs
 472  -L|--hardlink like -l but creates hardlinks
 473  -p|--prefix   STRING - first part of catalog/directory name (default: vol_)
 474  -f|--filter   EXPR - Filter expression, see examples below and perlre manpage
 475  --flat        Flat dir mode, don't recreate subdirectory structure (not recommended)
 476  -e|--expmode  NUMBER, special exploration modes, used with directory argument
 477
 478   1: (default) native exploration of the specified directory, but file sizes
 479                are rounded up to 2048 blocks plus estimated overhead for
 480                filenames (see -o option)
 481   2: like 1, but all files in directory are put together (as \"atom\") onto the
 482                same medium. This does not apply to subdirectories, however.
 483   3: like 2, but don't coalesc files when the size of the \"atom\" becomes too
 484                large for the medium size (currently $max)
 485   4: like 2, but the max. size of the atoms is limited to $max (storing the
 486                rest on another medium)
 487
 488  -F|--follow   Follow symlinks. Use with care!
 489  -b|--blksize  NUMBER, block size of the target filesystem (currently $bsize).
 490  -o|--overhead NUMBER, overhead caused by directory entries (as factor for the
 491                filename length, default: 50, empiricaly found for Joliet+RR
 492                with not-so-deep directory structure). Works in exploration
 493                mode.
 494  -a|--accuracy NUMBER (1=faster, large number=better efficiency, default: 500)
 495  -S|--simple   Simple/stupid/alphabetic mode
 496  -T|--input    FILENAME (or - for STDIN):  List with sizes and paths, try:
 497                find dir -type f -printf \"%s %p\n\"
 498                to get an example. Avoid duplicates! Unit suffixes are allowed.
 499  -h|--help     Show this option summary
 500  -v|--verbose  More verbosity
 501
 502 File sizes are expected to be in bytes, append modifier letters to multiply
 503 with a factor, eg 200M (b,k,K,m,M,g,G for Bytes, Kb, KiB, Mb, MiB, Gb, GiB).
 504 The default output mode is creating file catalogs useable with
 505     mkisofs -D -r --joliet-long -graft-points -path-list CATALOG
 506
 507 Examples:
 508 dirsplit -m -s 120M -e4 largedirwithdata/ -p /zipmedia/backup_   #move stuff into splitted backup dirs
 509 dirsplit -s 700M -e2 music/ # make mkisofs catalogs to burn all music to 700M CDRs, keep single files in each dir together
 510 dirsplit -s 700M -e2 -f '/other\\/Soundtracks/' music/ # like above, only take files from other/Soundtracks
 511 dirsplit -s 700M -e2 -f '!/Thumbs.db|Desktop.ini|\\.m3u\$/i' # like above, ignore some junk files and playlists, both letter cases
 512
 513 Bugs: overhead trough blocksize alignment and directory entry storage varies,
 514 heavily depends on the target filesystem and configuration (see -b and -o).
 515
 516 You should compare the required size of the created catalogs, eg.:
 517 for x in *list ; do mkisofs -quiet -D -r --joliet-long -graft-points \\
 518  -path-list \$x -print-size; done
 519 (output in blocks of 2048 bytes) with the expected size (-s) and media data
 520 (cdrecord -v -toc ...).
 521 ";
 522    print $msglong;
 523    exit 0;
 524 }
 525
 526 # Parms: bin size (int), input array (arr reference), output array (arr reference)
 527 # Returns: wasted space (int)
 528 sub bp_bestfit {
 529    my $max=$_[0];
 530    my @in = @{$_[1]};
 531    my $target = $_[2];
 532    my @out;
 533    my @bel;
 534
 535    my @tmp;
 536    push(@tmp,$in[0]);
 537    push(@out, \@tmp);
 538    $bel[0] = $in[0];
 539    shift @in;
 540
 541    for(@in) {
 542       my $bestplace=$#out+1;
 543       my $bestwert=$max;
 544       for($i=0;$i<=$#out;$i++) {
 545          my $rest;
 546          $rest=$max-$bel[$i]-$_;
 547          if($rest>0 && $rest < $bestwert) {
 548             $bestplace=$i;
 549             $bestwert=$rest;
 550          };
 551       }
 552       if($bestplace>$#out) {
 553          my @bin;
 554          $bel[$bestplace]=$_;
 555          push(@bin, $_);
 556          push(@out,\@bin);
 557       }
 558       else{
 559          $bel[$bestplace]+=$_;
 560          push(  @{$out[$bestplace]}    , $_);
 561       }
 562    }
 563    my $ret=0;
 564    # count all rests but the last one
 565    for($i=0;$i<$#out;$i++) {
 566       $ret+=($max-$bel[$i]);
 567    }
 568    @{$target} = @out;
 569    return $ret;
 570 }
 571
 572 # Parms: bin size (int), input array (arr reference), output array (arr reference)
 573 # Returns: wasted space (int)
 574 sub bp_firstfit {
 575    my $max=$_[0];
 576    my @in = @{$_[1]};
 577    my $target = $_[2];
 578    my @out;
 579    my @bel;
 580
 581    piece: foreach my $obj (@in) {
 582       # first fit, use the first bin with enough free space
 583       #       print "F: bin$i: $obj, @{$names{$obj}}\n";
 584       for($i=0;$i<=$#out;$i++) {
 585          my $newsize=($bel[$i]+$obj);
 586 #         print "bel[i]: $bel[$i], new?: $newsize to max: $max\n";
 587          if( $newsize <= $max ) {
 588 #            print "F: bin$i: $bel[$i]+$obj=$newsize\n";
 589             #fits here
 590             $bel[$i]=$newsize;
 591             push(  @{$out[$i]} , $obj);
 592             next piece; # break
 593          }
 594       }
 595       # neues Bin
 596       my @bin;
 597       $bel[$i]=$obj;
 598 #      print "N: bin$i: $bel[$i]=$obj\n";
 599       push(@bin, $obj);
 600       push(@out,\@bin);
 601    }
 602    my $ret=0;
 603    # sum up all rests except of the one from the last bin
 604    for($i=0;$i<$#out;$i++) {
 605 #           print "hm, bel $i ist :".$bel[$i]." und res:".($max-$bel[$i])."\n";
 606       $ret+=($max-$bel[$i]);
 607    }
 608    @{$target} = @out;
 609 #      print "wtf, ".join(",", @{$out[0]})."\n";
 610    return $ret;
 611 }