Het volgende perl-programma accepteert gecomprimeerde bestanden in andere formaten (.tar.gz, .tgz. .tar.Z, en .Z ) en pakt ze opnieuw in voor betere compressie. De perl-source heeft alle soorten handige documentatie over wat het doet en hoe het dit doet. Deze laatste versie accepteert bestanden als invoer op de commando-regel. Zonder commando-regel argumenten, probeert het ieder bestand in de huidige werkdirectory opnieuw in te pakken.
#!/usr/bin/perl -w ########################################################## # # # Dit programma zet ingepakte en met gzip gecomprimeerde # # programma's in de huidige directory om in het bzip2 # # formaat. Het handelt de .tgz extensie op een redelijke # # manier af door er een .tar.bz2 bestand van te maken. # # # ########################################################## $counter = 0; $saved_bytes = 0; $totals_file = '/tmp/machine_bzip2_total'; $machine_bzip2_total = 0; @raw = (defined @ARGV)?@ARGV:<*>; foreach(@raw) { next if /^bzip/; next unless /\.(tgz|gz|Z)$/; push @files, $_; } $total = scalar(@files); foreach (@files) { if (/tgz$/) { ($new=$_) =~ s/tgz$/tar.bz2/; } else { ($new=$_) =~ s/\.g?z$/.bz2/i; } $orig_size = (stat $_)[7]; ++$counter; print "Repacking $_ ($counter/$total)...\n"; if ((system "gzip -cd $_ |bzip2 >$new") == 0) { $new_size = (stat $new)[7]; $factor = int(100*$new_size/$orig_size+.5); $saved_bytes += $orig_size-$new_size; print "$new is about $factor% of the size of $_. :",($factor<100)?')':'(',"\n"; unlink $_; } else { print "Arrgghh! Er is iets gebeurd met $_: $!\n"; } } print "Je hebt " , ($saved_bytes>=0)?"bespaard ":"verloren " , abs($saved_bytes) , " bytes aan opslagruimte :" , ($saved_bytes>=0)?")":"(" , "\n" ; unless (-e '/tmp/machine_bzip2_total') { system ('echo "0" >/tmp/machine_bzip2_total'); system ('chmod', '0666', '/tmp/machine_bzip2_total'); } chomp($machine_bzip2_total = `cat $totals_file`); open TOTAL, ">$totals_file" or die "Kan system-wide totaalniet openen: $!"; $machine_bzip2_total += $saved_bytes; print TOTAL $machine_bzip2_total; close TOTAL; print "Dat is een totaal van ",`cat $totals_file`," bytes bespaard.\n";