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 ########################################
27 ########################################
28 # Possible mount points. Must be unique in their tails after rightmost /.
29 my @possible_mount_points;
31 # Directory relative to a mount point where new data resides.
32 # Must agree with Monikop's setting.
33 my $path_under_mount_point;
35 # Directories of this name will be deleted.
36 # Must agree with Monikop's setting.
37 my $path_under_mount_point_backed_up;
39 # Directory name while being deleted by monikop.
40 # Must agree with Monikop's setting.
41 my $path_under_mount_point_being_deleted;
46 # Credentials of the remote rsync server. String, or 0 if not used.
50 # Full path to rsync's raw log
53 # Full path to a file to store list of rsync's incompletely transferred files in:
54 my $interrupted_prefix;
56 # Shut down when finished? (default); 1 = yes; 2 = stay on.
57 my $shut_down_when_done :shared
;
62 # Rsync's directory (relative to destination) for partially transferred files.
63 # Must agree with Monikop's setting.
64 my $rsync_partial_dir_name;
66 # Local changes to the above.
67 eval `cat $pokinom_config`;
69 # Places for running rsyncs to put their runtime info in
71 my %progress_ratios :shared
;
74 sub debug_print
{ if ($debug) { print @_; } };
76 # Return sorted intersection of arrays which are supposed to have unique
79 my @intersection = ();
82 foreach $element (@_) { $count{$element}++ }
83 foreach $element (keys %count) {
84 push @intersection, $element if $count{$element} > 1;
89 # Write @content to a file with name $filename.
91 my ($filename, @content) = @_;
92 open FILE
, '>', $filename
93 or die "[" . $$ . "] open $filename failed: $!\n";
102 sub rsync_preparation_form
{
104 $speeds{$source} = "-";
107 ########## Capture rsync's status messages for use by UI
108 '$rsync_outfun{\'', $source, '\'} = sub {',
109 ' my ($outline, $outputchannel) = @_ ; ',
110 ' my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
111 ' my ($progress_ratio) = $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
112 ' if ($speed and $outputchannel eq \'out\') {',
113 ' $speeds{\'', $source, '\'} = $speed;',
115 ' $speeds{\'', $source, '\'} = "-";',
117 ' if ($progress_ratio and $outputchannel eq \'out\') {',
118 ' $progress_ratios{\'', $source, '\'} = $progress_ratio;',
123 '$rsync{\'', $source, '\'} = File::Rsync->new; ',
124 ########## Return fodder for another eval
125 '$rsync_exec_form{\'', $source, '\'} = sub {',
126 ' \'$rsync{\\\'', $source, '\\\'}->exec(',
128 ' src => \\\'', $source_roots{$source}, '/', $path_under_mount_point, '/\\\', ',
129 ' dest => \\\'' . $destination . '/\\\', ',
130 ' outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
131 ' progress => 1, debug => 0, verbose => 0, ',
132 ' filter => [\\\'merge,- ', $interrupted_prefix, $source, '\\\'], ',
133 ' literal => [\\\'--recursive\\\', \\\'--times\\\', ',
134 ' \\\'--partial-dir=', $rsync_partial_dir_name, '\\\', ',
135 ' \\\'--update\\\', ',
136 ' \\\'--prune-empty-dirs\\\', ',
137 ' \\\'--log-file-format=%i %b %n\\\', ',
138 ' , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
145 sub act_on_keypress
{
146 my ($pressed_key) = @_;
147 if ($pressed_key eq 267) { qx($shut_down_action); }
148 elsif ($pressed_key eq 273) { # F9
149 $shut_down_when_done = $shut_down_when_done ?
0 : 1; }
152 $ENV{USER
} = $rsync_username if ($rsync_username);
153 $ENV{RSYNC_PASSWORD
} = $rsync_password if ($rsync_password);
155 # Preparations done; sleeves up!
157 # Find usable (i.e. mounted) sources
158 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
159 chomp @raw_mount_points;
160 my @sources = intersection
@raw_mount_points, @possible_mount_points;
161 debug_print
"SOURCES:\n";
162 debug_print
@sources;
164 # Turn a path into a legal perl identifier:
165 sub make_key_from_path
{
167 ($path) =~ s/\/?(.*)\/?
/$1/g;
173 $source_roots{make_key_from_path
$_} = $_
176 my %being_deleted_thread;
177 # Clean up sources if necessary
179 my $p_i_d = $source_roots{$_} . '/' . $path_under_mount_point;
180 my $p_i_d_being_deleted = $source_roots{$_} . '/' . $path_under_mount_point_being_deleted;
181 $being_deleted_thread{$_} = async
{ qx(rm
-rf
$p_i_d_being_deleted 2> /dev/null
); };
182 } keys %source_roots;
184 # This could be more sophisticated
185 print "Waiting for $destination to become reachable.\n";
188 my %rsync_worker_thread;
191 # Set up and start things per source_root, in parallel:
193 $progress_ratios{$_} = "?"; # Initialize for UI
195 $rsync_worker_thread{$_} = async
{
196 my $rsync_log_name = $rsync_log_prefix . $_;
197 debug_print
'rsync_preparation_form:' . rsync_preparation_form
($_). "\n";
198 eval rsync_preparation_form
$_;
199 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
200 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
201 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
202 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
203 # Write exclusion list: don't transfer files Monikop gave up upon.
204 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
205 write_list
$interrupted_prefix . $_, @interrupted;
206 debug_print
"INTERRUPTED";
207 debug_print
@interrupted;
208 if (-d
$complete_source) {
209 if (eval ($rsync_exec_form{$_}() )) {
210 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
212 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
215 $progress_ratios{$_} = "Wait";
218 } keys %source_roots;
220 # Repeat rsync runs, this time sequentially, in order to get the newest of a file
221 # which may exist in multiple versions on different sources:
222 my $rsync_worker_thread = async
{
224 $rsync_worker_thread{$_}->join;
225 debug_print
"JOINED $_\n";
226 } keys %source_roots;
228 $progress_ratios{$_} = "?"; # Initialize for UI
230 my $rsync_log_name = $rsync_log_prefix . $_;
231 eval rsync_preparation_form
$_;
232 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
233 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
234 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
235 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
236 # Write exclusion list: don't transfer files Monikop gave up upon.
237 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
238 write_list
$interrupted_prefix . $_, @interrupted;
239 if (-d
$complete_source) {
240 if (eval ($rsync_exec_form{$_}() )) {
241 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
242 qx(mv
$complete_source $complete_source_backed_up);
244 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
247 $progress_ratios{$_} = "Done";
251 unlink $rsync_log_name;
252 unlink $interrupted_prefix . $_;
254 } keys %source_roots;
258 # Let the workers toil.
261 # Let the workers toil and talk to the user.
266 my $window_top = newwin
(LINES
() - 8, 79, 0, 0);
267 my $window_center = newwin
(5, 79, LINES
() - 8, 0);
268 my $window_bottom = newwin
(3, 79, LINES
() - 3, 0);
269 $window_bottom->keypad(1);
270 $window_bottom->nodelay(1);
272 init_pair
1, COLOR_MAGENTA
, COLOR_BLACK
;
273 init_pair
2, COLOR_RED
, COLOR_BLACK
;
274 init_pair
3, COLOR_CYAN
, COLOR_BLACK
;
275 init_pair
4, COLOR_YELLOW
, COLOR_BLACK
;
276 my $MAGENTA = COLOR_PAIR
(1);
277 my $RED = COLOR_PAIR
(2);
278 my $CYAN = COLOR_PAIR
(3);
279 my $YELLOW = COLOR_PAIR
(4);
281 $window_top->attron($CYAN);
282 $window_top->box(0,0);
283 $window_top->addstr(0, 30, " P r o g r e s s ");
284 $window_top->attroff($CYAN);
285 my $sources_format = "%-25s%-18s%-8s";
286 $window_top->attron(A_BOLD
);
287 $window_top->addstr(1, 12,
288 sprintf ($sources_format,
289 "Source Medium", "Speed", "To Do"));
290 $window_top->attroff(A_BOLD
);
294 $window_top->attron($CYAN);
295 $window_top->attron($RED) if $done{$source};
296 $window_top->addstr($line_number, 12,
297 sprintf($sources_format,
298 substr($source_roots{$source}, 0, 24),
299 substr($speeds{$source}, 0, 17),
300 substr($progress_ratios{$source}, -8, 8)));
302 $window_top->addstr($line_number, 1,
303 sprintf($sources_format, "", "", "", ""));
304 $window_top->attroff($RED);
305 $window_top->attroff($CYAN);
306 } sort (keys %source_roots);
309 $window_center->addstr($line_number, 2, $_);
312 $window_center->move(0, 0);
314 $window_bottom->box(0,0);
315 $window_bottom->attron(A_BOLD
);
316 $window_bottom->addstr(1, 3,
317 sprintf ("[F3]: Turn off now.%54s",
318 $shut_down_when_done ?
"Turning off when done. [F9]: Stay on."
319 : "Staying on. [F9]: Turn off when done."));
320 $window_bottom->attroff(A_BOLD
);
322 $window_top->refresh();
323 $window_bottom->refresh();
324 $window_center->refresh(); # Last window gets the cursor.
326 act_on_keypress
($window_bottom->getch());
327 if (! grep(/0/, values %done) && $shut_down_when_done) {
328 qx ($shut_down_action);
334 # Tidy up. (Except we don't reach this.)
336 $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
337 } keys %source_roots;
339 $rsync_worker_thread->join if $rsync_worker_thread{$_};