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
|
#!/usr/bin/perl
use strict;
require packdrake;
#- general information.
my $default_size = 400000;
my $default_ratio = 6;
sub usage {
die "packdrake version " . $packdrake::VERSION . "
Copyright (C) 2000 MandrakeSoft.
This is free software and may be redistributed under the terms of the GNU GPL.
usage:
--help - print this help message.
--build <file> - build archive <file> with filenames given on
standard input.
-[1..9] - select appropriate compression ratio, $default_ratio by default.
--dir <srcdir> - set source directory where to search files, \".\" by default.
--size <cmd> - set maximun chunk size, $default_size by default.
--method <cmd> - select standard compression command method, default
is set according to archive filename, example is
/bin/gzip or /usr/bin/bzip2.
--compress <cmd> - select compression command.
--uncompress <cmd> - select uncompression command.
--extract <file> <dir> - extract archive <file> contents to directory <dir>,
specific file to extract are given on command line.
--uncompress <cmd> - override uncompression method in archive <file>.
--list <file> - list contents of archive.
--cat <file> - dump archive, only supported with gzip and bzip2,
this write the contents of all file in archive.
";
}
sub main {
my ($file, $mode, $dir, $size, $method, $compress, $uncompress, $ratio);
my @nextargv = (\$file);
my @list = ();
#- some quite usefull error message.
my $error_mode = "packdrake: choose only --build, --extract, --list or --cat\n";
for (@_) {
/^--help$/ and do { usage; next };
/^--build$/ and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next };
/^--extract$/ and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next };
/^--list$/ and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next };
/^--cat$/ and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next };
/^--dir$/ and do { push @nextargv, \$dir; next };
/^--size$/ and do { push @nextargv, \$size; next };
/^--method$/ and do { push @nextargv, \$method; next };
/^--compress$/ and do { push @nextargv, \$compress; next };
/^--uncompress$/ and do { push @nextargv, \$uncompress; next };
/^-(.*)$/ and do { foreach (split //, $1) {
/[1-9]/ and do { $ratio = $_; next };
/b/ and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next };
/x/ and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next };
/l/ and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next };
/c/ and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next };
/d/ and do { push @nextargv, \$dir; next };
/s/ and do { push @nextargv, \$size; next };
/m/ and do { push @nextargv, \$method; next };
die "packdrake: unknown option \"-$1\", check usage with --help\n"; } next };
$mode =~ /extract|list|cat/ or @nextargv or die "packdrake: unknown option \"$_\", check usage with --help\n";
my $ref = shift @nextargv; $ref ? $$ref = $_ : push @list, $_;
$mode ||= "list";
}
#- examine and lauch.
$file or die "packdrake: no archive filename given, check usage with --help\n";
$size ||= 400000;
$ratio ||= 6;
unless ($method) {
$file =~ /\.cz$/ and $method = "gzip";
$file =~ /\.cz2$/ and $method = "bzip2";
}
$compress ||= "$method -$ratio";
$uncompress ||= "$method -d";
$mode =~ /extract/ && !$dir && !@list and ($mode, @list) = ('list', $file);
for ($mode) {
/build/ and do { packdrake::build_archive(\*STDIN, $dir, $file, $size, $compress, $uncompress); last };
/extract/ and do { my $packer = new packdrake($file); $packer->extract_archive($dir, @list); last };
/list/ and do { packdrake::list_archive($file, @list); last };
/cat/ and do { packdrake::cat_archive($file, @list); last };
die "packdrake: internal error, unable to select right mode?\n";
}
}
#- start the stuff.
main(@ARGV);
|
