equal
deleted
inserted
replaced
4 use strict; |
4 use strict; |
5 use warnings; |
5 use warnings; |
6 use POSIX qw(strftime); |
6 use POSIX qw(strftime); |
7 use autodie qw(:all); |
7 use autodie qw(:all); |
8 use Digest::MD5 qw(md5_hex); |
8 use Digest::MD5 qw(md5_hex); |
9 use File::Path qw(mkpath); |
|
10 use File::Basename; |
9 use File::Basename; |
11 use File::Temp; |
10 use File::Temp; |
12 use Sys::Hostname; |
11 use Sys::Hostname; |
13 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy); |
12 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy); |
14 use Hash::Util qw(lock_keys); |
13 use Hash::Util qw(lock_keys); |
15 use Getopt::Long; |
14 use Getopt::Long; |
16 use Pod::Usage; |
15 use Pod::Usage; |
|
16 use Fops; |
17 |
17 |
18 use constant KiB => 1024; |
18 use constant KiB => 1024; |
19 use constant MiB => 1024 * KiB; |
19 use constant MiB => 1024 * KiB; |
20 use constant GiB => 1024 * MiB; |
20 use constant GiB => 1024 * MiB; |
21 use constant NOW => time(); |
21 use constant NOW => time(); |
37 comment => undef, |
37 comment => undef, |
38 ); |
38 ); |
39 lock_keys(%o); |
39 lock_keys(%o); |
40 |
40 |
41 my $NOW = time(); |
41 my $NOW = time(); |
|
42 my $FOPS; |
42 |
43 |
43 MAIN: { |
44 MAIN: { |
44 GetOptions( |
45 GetOptions( |
45 "h|help" => sub { pod2usage(-verbose => 1, exit => 0) }, |
46 "h|help" => sub { pod2usage(-verbose => 1, exit => 0) }, |
46 "m|man" => sub { |
47 "m|man" => sub { |
67 ) |
68 ) |
68 and @ARGV >= 2 |
69 and @ARGV >= 2 |
69 or pod2usage; |
70 or pod2usage; |
70 |
71 |
71 my $dst = pop @ARGV; |
72 my $dst = pop @ARGV; |
|
73 $FOPS = Fops->new(native => $dst); |
|
74 |
72 foreach my $src (@ARGV) { |
75 foreach my $src (@ARGV) { |
73 if (my $pid = fork()) { |
76 if (my $pid = fork()) { |
74 next; |
77 next; |
75 } |
78 } |
76 elsif (not defined $pid) { |
79 elsif (not defined $pid) { |
84 |
87 |
85 } |
88 } |
86 |
89 |
87 sub save { |
90 sub save { |
88 my ($src, $dst) = @_; |
91 my ($src, $dst) = @_; |
89 my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/"; |
92 my $idx = "/idx/{HOSTNAME}/{DEVICE}/"; |
90 my $data = "{DIR}/data"; |
93 my $data = "/data"; |
91 my $info = "{DIR}/data/info"; |
94 my $info = "/data/info"; |
92 my $size; |
95 my $size; |
93 |
96 |
94 foreach ($idx, $data, $info) { |
97 foreach ($idx, $data, $info) { |
95 s/{DIR}/$dst/g; |
|
96 s/{HOSTNAME}/hostname/eg; |
98 s/{HOSTNAME}/hostname/eg; |
97 s/{DEVICE}/get_devname($src)/eg; |
99 s/{DEVICE}/get_devname($src)/eg; |
98 } |
100 } |
99 $size = get_devsize($src); |
101 $size = get_devsize($src); |
100 |
102 |
101 -d $dst or die "$0: $dst: $!\n"; |
103 #-d $dst or die "$0: $dst: $!\n"; |
102 mkpath([$data, $idx, $info]); |
104 $FOPS->stat("/") or die "$0: $dst: $!\n"; |
|
105 $FOPS->is_dir("/") or die "$0: $dst: $!\n"; |
|
106 $FOPS->mkpath($data, $idx, $info); |
103 |
107 |
104 my %index; |
108 my %index; |
105 $index{META} = { |
109 $index{META} = { |
106 format => 1, |
110 format => 1, |
107 host => hostname, |
111 host => hostname, |
150 |
154 |
151 # the extension we do not put into the index |
155 # the extension we do not put into the index |
152 push @{ $index{BLOCKS} }, sprintf "%12d %s %s" => ($. - 1), |
156 push @{ $index{BLOCKS} }, sprintf "%12d %s %s" => ($. - 1), |
153 $cs, $file; |
157 $cs, $file; |
154 |
158 |
155 if ( |
159 if (not( |
156 not( -e "$data/$file" |
160 $Fops->is_file("$data/$file"), |
157 or -e "$data/$file.gz" |
161 or $Fops->is_file("$data/$file.gz"), |
158 or -e "$data/$file.x" |
162 or $Fops->is_file("$data/$file.x"), |
159 or -e "$data/$file.gz.x" |
163 or $Fops->is_file("$data/$file.gz.x"), |
160 or -e "$data/$file.x.gz") |
164 or $Fops->is_file("$data/$file.x.gz")) |
161 ) |
165 ) |
162 { |
166 { |
163 mkpath dirname("$data/$file"); |
167 $FOPS->mkpath(dirname("$data/$file")); |
164 my $out = File::Temp->new( |
168 my $out = File::Temp->new( |
165 TEMPLATE => "tmp-XXXXXXX", |
169 TEMPLATE => "tmp-XXXXXXX", |
166 DIR => dirname("$data/$file") |
170 DIR => dirname("$data/$file") |
167 ); |
171 ); |
168 |
172 |