forked from pflanze/chj-scripts
-
Notifications
You must be signed in to change notification settings - Fork 0
/
bestzip
executable file
·106 lines (96 loc) · 2.93 KB
/
bestzip
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
#!/usr/bin/perl -w
# Son Jun 17 00:38:23 CEST 2007
(my $email='XXX%YYY,ch')=~ tr/%,/@./;
use strict;
$0=~ /(.*?)([^\/]+)\z/s or die "?";
my ($mydir, $myname)=($1,$2);
sub usage {
print STDERR map{"$_\n"} @_ if @_;
print "$myname file(s)
(Christian Jaeger <$email>)
";
exit (@_ ? 1 : 0);
}
my @args;
my $DEBUG=0;
for (my $i=0; $i<=$#ARGV; $i++) {
local $_=$ARGV[$i];
if (/^--?h(elp)?$/) {
usage
} elsif ($_ eq '--') {
push @args, @ARGV[$i+1..$#ARGV];
last;
} elsif (/^--?d(ebug)?$/) {
$DEBUG=1;
# } elsif (/^--?X(?:XXX(?:=(.*))?)?$/) {
# if (defined $1) {
# $XXX=$1
# } else {
# $XXX=$ARGV[++$i] or usage "missing argument for '$_' option";
# }
} elsif (/^-./) {
usage("Unknown option '$_'\n");
} else {
push @args, $_
}
}
usage unless @args;
use Chj::xperlfunc;
sub tryzip {
my ($cmdPlus,$infile)=@_;
#my ($cmd,$outfile)= $cmdPlus->($infile);
#xxsystem @$cmd;
my $outfile= $cmdPlus->($infile);
[ $outfile, xstat($outfile)->size ]
}
our @cmdPlus=
(
sub {
my ($infile)=@_;
#["bzip2","-k",$infile]
xxsystem "bzip2","-k",$infile;
$infile.".bz2"
},
# the following must be LAST now because it unlinks the original file!:
sub {
my ($infile)=@_;
#["gzip","--best","-c",$infile] # grrr. gibt kein -k. muss stdout dann umleiten. ergo, hm, hab ich das nid mal gemacht. ausführ exec kommandos in perl.
#----AH aber wenn ichs als letztes mach ist das auch egal.!
#aber haben eh schon auf xxsystem gestellt. so bi it.
xxsystem "gzip","--best",$infile;
$infile.".gz"
# #scsh wirklich mal studieren wohl.
# my $outfile= $infile.".gz";
# my $st= xstat $infile;###TO DO: how to handle symlinks? and hardlinks?. check for those first?
# # do not check if exists.
# my $t= xtmpfile $outfile;
# if (xfork) {
# xwait;
# #hm und now? perms, times. und nein, kein putback. "aha", muss übernehmen von anderm pfad. hoho.
# #aber zuerst mal richtigen ort tun.
# #ah modus kann gleich der richtige sein--ehr,wellnein wenn schon exists: muss eh neu gesetzt werden.
# $t->xputback (0);
# my $tpath= $t->path;
# xutime $st->atime, $st->mtime, $tpath;
# chown $st->uid, $st->gid, $tpath ;######klar nid xchown. aber was wenn nid geht how perms hm isch es nid eh unsafe das gzip und so? to do
# #also chmod kein setuid einfach aha eh hm.
# #mensch alles nur wegen idiotic. hmm was wenn einfach zippen lassen? als letzhtes!
# !!!!!
# } else {
# $t->xdup2(1);
# xexec "gzip","--best","-c",$infile
# }
# $t->path;
},
);
for my $file (@args) {
local our @out= map {
tryzip $_,$file
} @cmdPlus;
# find the smallest
@out= sort { $$a[1] <=> $$b[1] } @out;
#use Chj::repl;repl;
my $keep= shift @out;
# unlink the rest:
xunlink $$_[0] for @out;
}