10 my @pokinom_banner = (
11 " _/_/_/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/ _/",
12 " _/ _/ _/ _/ _/ _/ _/ _/_/ _/ _/ _/ _/_/ _/_/ ",
13 " _/_/_/ _/ _/ _/_/ _/ _/ _/ _/ _/ _/ _/ _/ _/ ",
14 " _/ _/ _/ _/ _/ _/ _/ _/_/ _/ _/ _/ _/ ",
15 "_/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/ _/ ",
19 # 0 = clean UI; 1 = lots of scrolling junk; anything else = both (pipe to file)
22 # Where to read local configuration:
23 my $pokinom_config = '~/monikop/pokinom.config';
25 $pokinom_config = $ARGV[0]
28 ########################################
30 ########################################
31 # Possible mount points. Must be unique in their tails after rightmost /.
32 my @possible_mount_points;
34 # Directory relative to a mount point where new data resides.
35 # Must agree with Monikop's setting.
36 my $path_under_mount_point;
38 # Directories of this name will be deleted.
39 # Must agree with Monikop's setting.
40 my $path_under_mount_point_backed_up;
42 # Directory name while being deleted by monikop.
43 # Must agree with Monikop's setting.
44 my $path_under_mount_point_being_deleted;
49 # Credentials of the remote rsync server. String, or 0 if not used.
53 # Full path to rsync's raw log
56 # Full path to a file to store list of rsync's incompletely transferred files in:
57 my $interrupted_prefix;
59 # Shut down when finished? (default); 1 = yes; 2 = stay on.
60 my $shut_down_when_done :shared
;
65 # Rsync's directory (relative to destination) for partially transferred files.
66 # Must agree with Monikop's setting.
67 my $rsync_partial_dir_name;
69 # Local changes to the above.
70 eval `cat $pokinom_config`;
72 # Places for running rsyncs to put their runtime info in
74 my %progress_ratios :shared
;
77 sub debug_print
{ if ($debug) { print @_; } };
79 # Return sorted intersection of arrays which are supposed to have unique
82 my @intersection = ();
85 foreach $element (@_) { $count{$element}++ }
86 foreach $element (keys %count) {
87 push @intersection, $element if $count{$element} > 1;
92 # Write @content to a file with name $filename.
94 my ($filename, @content) = @_;
95 open FILE
, '>', $filename
96 or die "[" . $$ . "] open $filename failed: $!\n";
105 sub rsync_preparation_form
{
107 $speeds{$source} = "-";
110 ########## Capture rsync's status messages for use by UI
111 '$rsync_outfun{\'', $source, '\'} = sub {',
112 ' my ($outline, $outputchannel) = @_ ; ',
113 ' my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
114 ' my ($progress_ratio) = $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
115 ' if ($speed and $outputchannel eq \'out\') {',
116 ' $speeds{\'', $source, '\'} = $speed;',
118 ' $speeds{\'', $source, '\'} = "-";',
120 ' if ($progress_ratio and $outputchannel eq \'out\') {',
121 ' $progress_ratios{\'', $source, '\'} = $progress_ratio;',
126 '$rsync{\'', $source, '\'} = File::Rsync->new; ',
127 ########## Return fodder for another eval
128 '$rsync_exec_form{\'', $source, '\'} = sub {',
129 ' \'$rsync{\\\'', $source, '\\\'}->exec(',
131 ' src => \\\'', $source_roots{$source}, '/', $path_under_mount_point, '/\\\', ',
132 ' dest => \\\'' . $destination . '/\\\', ',
133 ' outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
134 ' progress => 1, debug => 0, verbose => 0, ',
135 ' filter => [\\\'merge,- ', $interrupted_prefix, $source, '\\\'], ',
136 ' literal => [\\\'--recursive\\\', \\\'--times\\\', ',
137 ' \\\'--partial-dir=', $rsync_partial_dir_name, '\\\', ',
138 ' \\\'--update\\\', ',
139 ' \\\'--prune-empty-dirs\\\', ',
140 ' \\\'--log-file-format=%i %b %n\\\', ',
141 ' , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
148 sub act_on_keypress
{
149 my ($pressed_key) = @_;
150 if ($pressed_key eq 267) { qx($shut_down_action); }
151 elsif ($pressed_key eq 273) { # F9
152 $shut_down_when_done = $shut_down_when_done ?
0 : 1; }
155 $ENV{USER
} = $rsync_username if ($rsync_username);
156 $ENV{RSYNC_PASSWORD
} = $rsync_password if ($rsync_password);
158 # Preparations done; sleeves up!
160 # Find usable (i.e. mounted) sources
161 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
162 chomp @raw_mount_points;
163 my @sources = intersection
@raw_mount_points, @possible_mount_points;
164 debug_print
"SOURCES:\n";
165 debug_print
@sources;
167 # Turn a path into a legal perl identifier:
168 sub make_key_from_path
{
170 ($path) =~ s/\/?(.*)\/?
/$1/g;
176 $source_roots{make_key_from_path
$_} = $_
179 my %being_deleted_thread;
180 # Clean up sources if necessary
182 my $p_i_d = $source_roots{$_} . '/' . $path_under_mount_point;
183 my $p_i_d_being_deleted = $source_roots{$_} . '/' . $path_under_mount_point_being_deleted;
184 $being_deleted_thread{$_} = async
{ qx(rm
-rf
$p_i_d_being_deleted 2> /dev/null
); };
185 } keys %source_roots;
187 # This could be more sophisticated
188 print "Waiting for $destination to become reachable.\n";
191 my %rsync_worker_thread;
194 # Set up and start things per source_root, in parallel:
196 $progress_ratios{$_} = "?"; # Initialize for UI
198 $rsync_worker_thread{$_} = async
{
199 my $rsync_log_name = $rsync_log_prefix . $_;
200 debug_print
'rsync_preparation_form:' . rsync_preparation_form
($_). "\n";
201 eval rsync_preparation_form
$_;
202 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
203 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
204 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
205 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
206 # Write exclusion list: don't transfer files Monikop gave up upon.
207 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
208 write_list
$interrupted_prefix . $_, @interrupted;
209 debug_print
"INTERRUPTED";
210 debug_print
@interrupted;
211 if (-d
$complete_source) {
212 if (eval ($rsync_exec_form{$_}() )) {
213 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
215 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
218 $progress_ratios{$_} = "Wait";
221 } keys %source_roots;
223 # Repeat rsync runs, this time sequentially, in order to get the newest of a file
224 # which may exist in multiple versions on different sources:
225 my $rsync_worker_thread = async
{
227 $rsync_worker_thread{$_}->join;
228 debug_print
"JOINED $_\n";
229 } keys %source_roots;
231 $progress_ratios{$_} = "?"; # Initialize for UI
233 my $rsync_log_name = $rsync_log_prefix . $_;
234 eval rsync_preparation_form
$_;
235 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
236 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
237 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
238 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
239 # Write exclusion list: don't transfer files Monikop gave up upon.
240 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
241 write_list
$interrupted_prefix . $_, @interrupted;
242 if (-d
$complete_source) {
243 if (eval ($rsync_exec_form{$_}() )) {
244 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
245 qx(mv
$complete_source $complete_source_backed_up);
247 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
250 $progress_ratios{$_} = "Done";
254 unlink $rsync_log_name;
255 unlink $interrupted_prefix . $_;
257 } keys %source_roots;
261 # Let the workers toil.
264 # Let the workers toil and talk to the user.
269 my $window_top = newwin
(LINES
() - 8, 79, 0, 0);
270 my $window_center = newwin
(5, 79, LINES
() - 8, 0);
271 my $window_bottom = newwin
(3, 79, LINES
() - 3, 0);
272 $window_bottom->keypad(1);
273 $window_bottom->nodelay(1);
275 init_pair
1, COLOR_MAGENTA
, COLOR_BLACK
;
276 init_pair
2, COLOR_RED
, COLOR_BLACK
;
277 init_pair
3, COLOR_CYAN
, COLOR_BLACK
;
278 init_pair
4, COLOR_YELLOW
, COLOR_BLACK
;
279 my $MAGENTA = COLOR_PAIR
(1);
280 my $RED = COLOR_PAIR
(2);
281 my $CYAN = COLOR_PAIR
(3);
282 my $YELLOW = COLOR_PAIR
(4);
284 $window_top->attron($CYAN);
285 $window_top->box(0,0);
286 $window_top->addstr(0, 30, " P r o g r e s s ");
287 $window_top->attroff($CYAN);
288 my $sources_format = "%-25s%-18s%-8s";
289 $window_top->attron(A_BOLD
);
290 $window_top->addstr(1, 12,
291 sprintf ($sources_format,
292 "Source Medium", "Speed", "To Do"));
293 $window_top->attroff(A_BOLD
);
297 $window_top->attron($CYAN);
298 $window_top->attron($RED) if $done{$source};
299 $window_top->addstr($line_number, 12,
300 sprintf($sources_format,
301 substr($source_roots{$source}, 0, 24),
302 substr($speeds{$source}, 0, 17),
303 substr($progress_ratios{$source}, -8, 8)));
305 $window_top->addstr($line_number, 1,
306 sprintf($sources_format, "", "", "", ""));
307 $window_top->attroff($RED);
308 $window_top->attroff($CYAN);
309 } sort (keys %source_roots);
312 $window_center->addstr($line_number, 2, $_);
315 $window_center->move(0, 0);
317 $window_bottom->box(0,0);
318 $window_bottom->attron(A_BOLD
);
319 $window_bottom->addstr(1, 3,
320 sprintf ("[F3]: Turn off now.%54s",
321 $shut_down_when_done ?
"Turning off when done. [F9]: Stay on."
322 : "Staying on. [F9]: Turn off when done."));
323 $window_bottom->attroff(A_BOLD
);
325 $window_top->refresh();
326 $window_bottom->refresh();
327 $window_center->refresh(); # Last window gets the cursor.
329 act_on_keypress
($window_bottom->getch());
330 if (! grep(/0/, values %done) && $shut_down_when_done) {
331 qx ($shut_down_action);
337 # Tidy up. (Except we don't reach this.)
339 $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
340 } keys %source_roots;
342 $rsync_worker_thread->join if $rsync_worker_thread{$_};