File Coverage

blib/lib/App/Yabsm/Config/Query.pm
Criterion Covered Total %
statement 519 519 100.0
branch 88 92 95.6
condition 4 6 66.6
subroutine 87 87 100.0
pod 0 81 0.0
total 698 785 88.9


line stmt bran cond sub pod time code
1             # Author: Nicholas Hubbard
2             # WWW: https://github.com/NicholasBHubbard/yabsm
3             # License: MIT
4              
5             # Provides functions for querying the Yabsm configuration hash that is produced
6             # by Yabsm::Config::Parser::parse_config_or_die().
7              
8 7     7   564 use strict;
  7         17  
  7         165  
9 7     7   26 use warnings;
  7         10  
  7         127  
10 7     7   51 use v5.16.3;
  7         19  
11              
12             package App::Yabsm::Config::Query;
13              
14 7     7   674 use App::Yabsm::Tools qw(arg_count_or_die);
  7         11  
  7         328  
15              
16 7     7   39 use Carp qw(confess);
  7         18  
  7         265  
17              
18 7     7   32 use Exporter qw(import);
  7         35  
  7         33757  
19             our @EXPORT_OK = qw(is_timeframe
20             is_timeframe_or_die
21             is_weekday
22             is_weekday_or_die
23             time_hour
24             time_minute
25             yabsm_dir
26             yabsm_user_home
27             subvol_exists
28             subvol_exists_or_die
29             snap_exists
30             snap_exists_or_die
31             ssh_backup_exists
32             ssh_backup_exists_or_die
33             local_backup_exists
34             local_backup_exists_or_die
35             backup_exists
36             backup_exists_or_die
37             all_subvols
38             all_snaps
39             all_ssh_backups
40             all_local_backups
41             subvol_mountpoint
42             snap_subvol
43             snap_mountpoint
44             snap_dest
45             snap_dir
46             snap_timeframes
47             ssh_backup_subvol
48             ssh_backup_mountpoint
49             ssh_backup_dir
50             ssh_backup_timeframes
51             ssh_backup_ssh_dest
52             local_backup_subvol
53             local_backup_mountpoint
54             local_backup_dir
55             local_backup_timeframes
56             all_snaps_of_subvol
57             all_ssh_backups_of_subvol
58             all_local_backups_of_subvol
59             snap_wants_timeframe
60             snap_wants_timeframe_or_die
61             ssh_backup_wants_timeframe
62             ssh_backup_wants_timeframe_or_die
63             local_backup_wants_timeframe
64             local_backup_wants_timeframe_or_die
65             snap_timeframe_keep
66             snap_5minute_keep
67             snap_hourly_keep
68             snap_daily_keep
69             snap_daily_times
70             snap_weekly_keep
71             snap_weekly_time
72             snap_weekly_day
73             snap_monthly_keep
74             snap_monthly_time
75             snap_monthly_day
76             ssh_backup_timeframe_keep
77             ssh_backup_5minute_keep
78             ssh_backup_hourly_keep
79             ssh_backup_daily_keep
80             ssh_backup_daily_times
81             ssh_backup_weekly_keep
82             ssh_backup_weekly_time
83             ssh_backup_weekly_day
84             ssh_backup_monthly_keep
85             ssh_backup_monthly_time
86             ssh_backup_monthly_day
87             local_backup_timeframe_keep
88             local_backup_5minute_keep
89             local_backup_hourly_keep
90             local_backup_daily_keep
91             local_backup_daily_times
92             local_backup_weekly_keep
93             local_backup_weekly_time
94             local_backup_weekly_day
95             local_backup_monthly_keep
96             local_backup_monthly_time
97             local_backup_monthly_day
98             );
99             our %EXPORT_TAGS = ( ALL => [ @EXPORT_OK ] );
100              
101             ####################################
102             # SUBROUTINES #
103             ####################################
104              
105             sub is_timeframe {
106              
107             # Return 1 if given a valid timeframe and return 0 otherwise.
108              
109 127     127 0 968 arg_count_or_die(1, 1, @_);
110              
111 127         488 return 0+(shift =~ /^(5minute|hourly|daily|weekly|monthly)$/);
112             }
113              
114             sub is_timeframe_or_die {
115              
116             # Wrapper around &is_timeframe that Carp::Confess's if it returns false.
117              
118 120     120 0 712 arg_count_or_die(1, 1, @_);
119              
120 120         144 my $tframe = shift;
121              
122 120 100       142 unless ( is_timeframe($tframe) ) {
123 10         82 confess("yabsm: internal error: no such timeframe '$tframe'");
124             }
125              
126 110         143 return 1;
127             }
128              
129             sub is_weekday {
130              
131             # Return 1 if given a valid week day and return 0 otherwise.
132              
133 26     26 0 550 arg_count_or_die(1, 1, @_);
134              
135 26         127 return 0+(shift =~ /^(monday|tuesday|wednesday|thursday|friday|saturday|sunday)$/);
136             }
137              
138             sub is_weekday_or_die {
139              
140             # Wrapper around &is_weekday that Carp::Confess's if it returns false.
141              
142 17     17 0 539 arg_count_or_die(1, 1, @_);
143              
144 17         20 my $weekday = shift;
145              
146 17 100       23 unless ( is_weekday($weekday) ) {
147 3         23 confess("yabsm: internal error: no such weekday '$weekday'");
148             }
149              
150 14         37 return 1;
151             }
152              
153             sub weekday_number {
154              
155             # Return the number associated with $weekday which is a string representation
156             # of a weekday. Monday is considered the first day of the week.
157              
158 8     8 0 675 arg_count_or_die(1, 1, @_);
159              
160 8         10 my $weekday = shift;
161              
162 8         13 is_weekday_or_die($weekday);
163              
164 7 100       16 $weekday eq 'monday' and return 1;
165 6 100       24 $weekday eq 'tuesday' and return 2;
166 5 100       13 $weekday eq 'wednesday' and return 3;
167 4 100       10 $weekday eq 'thursday' and return 4;
168 3 100       8 $weekday eq 'friday' and return 5;
169 2 100       7 $weekday eq 'saturday' and return 6;
170 1 50       7 $weekday eq 'sunday' and return 7;
171             }
172              
173             sub is_time {
174              
175             # Return 1 if passed a valid 'hh:mm' time and return 0 otherwise.
176              
177 11     11 0 721 arg_count_or_die(1, 1, @_);
178              
179 11 100       51 my ($hr, $min) = shift =~ /^(\d\d):(\d\d)$/
180             or return 0;
181              
182 7 100 66     28 $hr >= 0 && $hr <= 23 or return 0;
183 6 100 66     18 $min >= 0 && $min <= 59 or return 0;
184              
185 5         13 return 1;
186             }
187              
188             sub is_time_or_die {
189              
190             # Wrapper around &is_time that Carp::Confess's if it returns false.
191              
192 6     6 0 520 arg_count_or_die(1, 1, @_);
193              
194 6         7 my $time = shift;
195              
196 6 100       9 unless ( is_time($time) ) {
197 3         21 confess("yabsm: internal error: '$time' is not a valid 'hh:mm' time");
198             }
199              
200 3         7 return 1;
201             }
202              
203             sub time_hour {
204              
205             # Return the hour of a 'hh:mm' time.
206              
207 2     2 0 667 arg_count_or_die(1, 1, @_);
208              
209 2         2 my $time = shift;
210              
211 2         3 is_time_or_die($time);
212              
213 1         4 my ($hr) = $time =~ /^(\d\d):\d\d$/;
214              
215 1         4 return 0+$hr;
216             }
217              
218             sub time_minute {
219              
220             # Return the minute of a 'hh:mm' time.
221              
222 2     2 0 720 arg_count_or_die(1, 1, @_);
223              
224 2         3 my $time = shift;
225              
226 2         5 is_time_or_die($time);
227              
228 1         3 my ($min) = $time =~ /^\d\d:(\d\d)$/;
229              
230 1         5 return 0+$min;
231             }
232              
233             sub yabsm_dir {
234              
235             # Return the users yabsm_dir without trailing /'s.
236              
237 5     5 0 668 arg_count_or_die(1, 1, @_);
238              
239 5         7 my $config_ref = shift;
240              
241 5         36 return $config_ref->{yabsm_dir} =~ s/\/+$//r;
242             }
243              
244             sub yabsm_user_home {
245              
246             # Return the yabsm users home directory.
247              
248 1     1 0 466 arg_count_or_die(1, 1, @_);
249              
250 1         2 return yabsm_dir( shift ) . '/.yabsm-var/yabsm-user-home';
251             }
252              
253             sub subvol_exists {
254              
255             # Return 1 if $subvol is a subvol defined in $config_ref and return 0
256             # otherwise.
257              
258 9     9 0 150 arg_count_or_die(2, 2, @_);
259              
260 9         12 my $subvol = shift;
261 9         10 my $config_ref = shift;
262              
263 9         29 return 0+(exists $config_ref->{subvols}{$subvol});
264             }
265              
266             sub subvol_exists_or_die {
267              
268             # Wrapper around &subvol_exists that Carp::Confess's if it returns false.
269              
270 7     7 0 614 arg_count_or_die(2, 2, @_);
271              
272 7         10 my $subvol = shift;
273 7         9 my $config_ref = shift;
274              
275 7 100       13 unless ( subvol_exists($subvol, $config_ref) ) {
276 2         24 confess("yabsm: internal error: no subvol named '$subvol'");
277             }
278              
279 5         9 return 1;
280             }
281              
282             sub snap_exists {
283              
284             # Return 1 if $snap is a snap defined in $config_ref and return 0 otherwise.
285              
286 121     121 0 1029 arg_count_or_die(2, 2, @_);
287              
288 121         130 my $snap = shift;
289 121         124 my $config_ref = shift;
290              
291 121         247 return 0+(exists $config_ref->{snaps}{$snap});
292             }
293              
294             sub snap_exists_or_die {
295              
296             # Wrapper around &snap_exists that Carp::Confess's if it returns false.
297              
298 119     119 0 787 arg_count_or_die(2, 2, @_);
299              
300 119         130 my $snap = shift;
301 119         113 my $config_ref = shift;
302              
303 119 100       153 unless ( snap_exists($snap, $config_ref) ) {
304 17         134 confess("yabsm: internal error: no snap named '$snap'");
305             }
306              
307 102         138 return 1;
308             }
309              
310             sub ssh_backup_exists {
311              
312             # Return 1 if $ssh_backup is a ssh_backup defined in $config_ref and return 0
313             # otherwise.
314              
315 129     129 0 939 arg_count_or_die(2, 2, @_);
316              
317 129         150 my $ssh_backup = shift;
318 129         155 my $config_ref = shift;
319              
320 129         249 return 0+(exists $config_ref->{ssh_backups}{$ssh_backup});
321             }
322              
323             sub ssh_backup_exists_or_die {
324              
325             # Wrapper around &ssh_backup_exists that Carp::Confess's if it returns false.
326              
327 121     121 0 758 arg_count_or_die(2, 2, @_);
328              
329 121         129 my $ssh_backup = shift;
330 121         120 my $config_ref = shift;
331              
332 121 100       149 unless ( ssh_backup_exists($ssh_backup, $config_ref) ) {
333 18         135 confess("yabsm: internal error: no ssh_backup named '$ssh_backup'");
334             }
335              
336 103         120 return 1;
337             }
338              
339             sub local_backup_exists {
340              
341             # Return 1 if $local_backup is a lcoal_backup defined in $config_ref and
342             # return 0 otherwise.
343              
344 125     125 0 977 arg_count_or_die(2, 2, @_);
345              
346 125         135 my $local_backup = shift;
347 125         113 my $config_ref = shift;
348              
349 125         255 return 0+(exists $config_ref->{local_backups}{$local_backup});
350             }
351              
352             sub local_backup_exists_or_die {
353              
354             # Wrapper around &local_backup_exists that Carp::Confess's if it returns
355             # false.
356              
357 119     119 0 760 arg_count_or_die(2, 2, @_);
358              
359 119         130 my $local_backup = shift;
360 119         113 my $config_ref = shift;
361              
362 119 100       160 unless ( local_backup_exists($local_backup, $config_ref) ) {
363 17         151 confess("yabsm: internal error: no local_backup named '$local_backup'");
364             }
365              
366 102         120 return 1;
367             }
368              
369             sub backup_exists {
370              
371             # Return 1 if $backup is either an ssh_backup or a local_backup and return 0
372             # otherwise.
373              
374 6     6 0 749 arg_count_or_die(2, 2, @_);
375              
376 6         6 my $backup = shift;
377 6         7 my $config_ref = shift;
378              
379 6 100       14 return 1 if ssh_backup_exists($backup, $config_ref);
380 4         8 return local_backup_exists($backup, $config_ref);
381             }
382              
383             sub backup_exists_or_die {
384              
385             # Wrapper around &backup_exists that Carp::Confess's if it returns false.
386              
387 3     3 0 560 arg_count_or_die(2, 2, @_);
388              
389 3         6 my $backup = shift;
390 3         4 my $config_ref = shift;
391              
392 3 100       5 unless ( backup_exists($backup, $config_ref) ) {
393 1         9 confess("yabsm: internal error: no ssh_backup or local_backup named '$backup'");
394             }
395              
396 2         10 return 1;
397             }
398              
399             sub all_subvols {
400              
401             # Return a list of all the subvol names defined in $config_ref.
402              
403 1     1 0 787 arg_count_or_die(1, 1, @_);
404              
405 1         1 my $config_ref = shift;
406              
407 1         2 my @subvols = sort keys %{ $config_ref->{subvols} };
  1         7  
408              
409 1         8 return @subvols;
410             }
411              
412             sub all_snaps {
413              
414             # Return a list of all the snap names defined in $config_ref.
415              
416 3     3 0 602 arg_count_or_die(1, 1, @_);
417              
418 3         4 my $config_ref = shift;
419              
420 3         4 my @snaps = sort keys %{ $config_ref->{snaps} };
  3         12  
421              
422 3         13 return @snaps;
423             }
424              
425             sub all_ssh_backups {
426              
427             # Return a list of all the ssh_backup names defined in $config_ref.
428              
429 2     2 0 536 arg_count_or_die(1, 1, @_);
430              
431 2         2 my $config_ref = shift;
432              
433 2         3 my @ssh_backups = sort keys %{ $config_ref->{ssh_backups} };
  2         11  
434              
435 2         9 return @ssh_backups;
436             }
437              
438             sub all_local_backups {
439              
440             # Return a list of all the local_backup names defined in $config_ref.
441              
442 2     2 0 547 arg_count_or_die(1, 1, @_);
443              
444 2         3 my $config_ref = shift;
445              
446 2         4 my @all_local_backups = sort keys %{ $config_ref->{local_backups} };
  2         10  
447              
448 2         10 return @all_local_backups;
449             }
450              
451             sub subvol_mountpoint {
452              
453             # Return the the subvol $subvol's mountpoint value.
454              
455 5     5 0 559 arg_count_or_die(2, 2, @_);
456              
457 5         8 my $subvol = shift;
458 5         6 my $config_ref = shift;
459              
460 5         12 subvol_exists_or_die($subvol, $config_ref);
461              
462 4         29 return $config_ref->{subvols}{$subvol}{mountpoint};
463             }
464              
465             sub snap_subvol {
466              
467             # Return the name of the subvol that $snap is snapshotting.
468              
469 3     3 0 564 arg_count_or_die(2, 2, @_);
470              
471 3         4 my $snap = shift;
472 3         5 my $config_ref = shift;
473              
474 3         7 snap_exists_or_die($snap, $config_ref);
475              
476 2         11 return $config_ref->{snaps}{$snap}{subvol};
477             }
478              
479             sub snap_mountpoint {
480              
481             # Return the mountpoint of the subvol that $snap is snapshotting.
482              
483 2     2 0 827 arg_count_or_die(2, 2, @_);
484              
485 2         4 my $snap = shift;
486 2         3 my $config_ref = shift;
487              
488 2         5 snap_exists_or_die($snap, $config_ref);
489              
490 1         3 my $subvol = snap_subvol($snap, $config_ref);
491              
492 1         4 return subvol_mountpoint($subvol, $config_ref);
493             }
494              
495             sub snap_dest {
496              
497             # Return $snap's destination. Optionally pass a timeframe via the $tframe
498             # value to append "/$tframe" to the returned dir.
499              
500 4     4 0 865 arg_count_or_die(3, 3, @_);
501              
502 4         7 my $snap = shift;
503 4         4 my $tframe = shift;
504 4         5 my $config_ref = shift;
505              
506 4         9 snap_exists_or_die($snap, $config_ref);
507              
508 3         7 my $dest = yabsm_dir($config_ref) . "/$snap";
509              
510 3 100       8 if ($tframe) {
511 2         6 snap_wants_timeframe_or_die($snap, $tframe, $config_ref);
512 1         7 return "$dest/$tframe";
513             }
514             else {
515 1         5 return $dest;
516             }
517             }
518              
519             sub snap_timeframes {
520              
521             # Return a list of $snap's timeframes.
522              
523 33     33 0 1016 arg_count_or_die(2, 2, @_);
524              
525 33         38 my $snap = shift;
526 33         362 my $config_ref = shift;
527              
528 33         53 snap_exists_or_die($snap, $config_ref);
529              
530 32         157 return sort split ',', $config_ref->{snaps}{$snap}{timeframes};
531             }
532              
533             sub ssh_backup_subvol {
534              
535             # Return the name of the subvol that $ssh_backup is backing up.
536              
537 3     3 0 841 arg_count_or_die(2, 2, @_);
538              
539 3         6 my $ssh_backup = shift;
540 3         3 my $config_ref = shift;
541              
542 3         7 ssh_backup_exists_or_die($ssh_backup, $config_ref);
543              
544 2         8 return $config_ref->{ssh_backups}{$ssh_backup}{subvol};
545             }
546              
547             sub ssh_backup_mountpoint {
548              
549             # Return the mountpoint of the subvol that $ssh_backup is backing up.
550              
551 2     2 0 839 arg_count_or_die(2, 2, @_);
552              
553 2         5 my $ssh_backup = shift;
554 2         3 my $config_ref = shift;
555              
556 2         5 ssh_backup_exists_or_die($ssh_backup, $config_ref);
557              
558 1         3 my $subvol = ssh_backup_subvol($ssh_backup, $config_ref);
559              
560 1         3 return subvol_mountpoint($subvol, $config_ref);
561             }
562              
563             sub ssh_backup_dir {
564              
565             # Return $ssh_backup's ssh_backup dir value. Optionally pass a timeframe via
566             # the $tframe value to append "/$tframe" to the returned dir.
567              
568 4     4 0 882 arg_count_or_die(3, 3, @_);
569              
570 4         7 my $ssh_backup = shift;
571 4         6 my $tframe = shift;
572 4         6 my $config_ref = shift;
573              
574 4         9 ssh_backup_exists_or_die($ssh_backup, $config_ref);
575              
576 3         13 my $dir = $config_ref->{ssh_backups}{$ssh_backup}{dir} =~ s/\/+$//r;
577              
578 3 100       6 if ($tframe) {
579 2         7 ssh_backup_wants_timeframe_or_die($ssh_backup, $tframe, $config_ref);
580 1         7 return "$dir/$tframe";
581             }
582             else {
583 1         6 return $dir;
584             }
585             }
586              
587             sub ssh_backup_timeframes {
588              
589             # Return a list of $ssh_backups's timeframes.
590              
591 33     33 0 1020 arg_count_or_die(2, 2, @_);
592              
593 33         33 my $ssh_backup = shift;
594 33         34 my $config_ref = shift;
595              
596 33         54 ssh_backup_exists_or_die($ssh_backup, $config_ref);
597              
598 32         164 return sort split ',', $config_ref->{ssh_backups}{$ssh_backup}{timeframes};
599             }
600              
601             sub ssh_backup_ssh_dest {
602              
603             # Return $ssh_backup's ssh_dest value.
604              
605 2     2 0 884 arg_count_or_die(2, 2, @_);
606              
607 2         2 my $ssh_backup = shift;
608 2         4 my $config_ref = shift;
609              
610 2         5 ssh_backup_exists_or_die($ssh_backup, $config_ref);
611              
612 1         6 return $config_ref->{ssh_backups}{$ssh_backup}{ssh_dest};
613             }
614              
615             sub local_backup_subvol {
616              
617             # Return the name of the subvol that $local_backup is backing up.
618              
619 3     3 0 824 arg_count_or_die(2, 2, @_);
620              
621 3         4 my $local_backup = shift;
622 3         4 my $config_ref = shift;
623              
624 3         8 local_backup_exists_or_die($local_backup, $config_ref);
625              
626 2         8 return $config_ref->{local_backups}{$local_backup}{subvol};
627             }
628              
629             sub local_backup_mountpoint {
630              
631             # Return the mountpoint of the subvol that $local_backup is backing up.
632              
633 2     2 0 978 arg_count_or_die(2, 2, @_);
634              
635 2         4 my $local_backup = shift;
636 2         4 my $config_ref = shift;
637              
638 2         6 local_backup_exists_or_die($local_backup, $config_ref);
639              
640 1         2 my $subvol = local_backup_subvol($local_backup, $config_ref);
641              
642 1         3 return subvol_mountpoint($subvol, $config_ref);
643             }
644              
645             sub local_backup_dir {
646              
647             # Return $local_backup's local_backup dir value. Optionally pass a timeframe
648             # via the $tframe value to append "/$tframe" to the returned dir.
649              
650 4     4 0 906 arg_count_or_die(3, 3, @_);
651              
652 4         6 my $local_backup = shift;
653 4         6 my $tframe = shift;
654 4         5 my $config_ref = shift;
655              
656 4         9 local_backup_exists_or_die($local_backup, $config_ref);
657              
658 3         14 my $dir = $config_ref->{local_backups}{$local_backup}{dir} =~ s/\/+$//r;
659              
660 3 100       6 if ($tframe) {
661 2         6 local_backup_wants_timeframe_or_die($local_backup, $tframe, $config_ref);
662 1         6 return "$dir/$tframe";
663             }
664             else {
665 1         6 return $dir;
666             }
667             }
668              
669             sub local_backup_timeframes {
670              
671             # Return a list of $local_backups's timeframes.
672              
673 33     33 0 934 arg_count_or_die(2, 2, @_);
674              
675 33         51 my $local_backup = shift;
676 33         33 my $config_ref = shift;
677              
678 33         51 local_backup_exists_or_die($local_backup, $config_ref);
679              
680 32         159 return sort split ',', $config_ref->{local_backups}{$local_backup}{timeframes};
681             }
682              
683             sub all_snaps_of_subvol {
684              
685             # Return a list of all the snaps in $config_ref that are snapshotting
686             # $subvol.
687              
688 1     1 0 850 arg_count_or_die(2, 2, @_);
689              
690 1         3 my $subvol = shift;
691 1         1 my $config_ref = shift;
692              
693 1         2 my @snaps;
694              
695 1         3 for my $snap ( all_snaps($config_ref) ) {
696             push @snaps, $snap
697 3 100       9 if ($subvol eq $config_ref->{snaps}{$snap}{subvol});
698             }
699              
700 1         7 return sort @snaps;
701             }
702              
703             sub all_ssh_backups_of_subvol {
704              
705             # Return a list of all the ssh_backups in $config_ref that are backing up
706             # $subvol.
707              
708 1     1 0 525 arg_count_or_die(2, 2, @_);
709              
710 1         2 my $subvol = shift;
711 1         2 my $config_ref = shift;
712              
713 1         2 my @ssh_backups;
714              
715 1         3 for my $ssh_backup ( all_ssh_backups($config_ref) ) {
716             push @ssh_backups, $ssh_backup
717 3 100       8 if ($subvol eq $config_ref->{ssh_backups}{$ssh_backup}{subvol});
718             }
719              
720 1         6 return sort @ssh_backups;
721             }
722              
723             sub all_local_backups_of_subvol {
724              
725             # Return a list of all the local_backups in $config_ref that are backing up
726             # $subvol.
727              
728 1     1 0 516 arg_count_or_die(2, 2, @_);
729              
730 1         22 my $subvol = shift;
731 1         3 my $config_ref = shift;
732              
733 1         15 my @local_backups;
734              
735 1         5 for my $local_backup ( all_local_backups($config_ref) ) {
736             push @local_backups, $local_backup
737 3 100       9 if ($subvol eq $config_ref->{local_backups}{$local_backup}{subvol});
738             }
739              
740 1         6 return sort @local_backups;
741             }
742              
743             sub snap_wants_timeframe {
744              
745             # Return 1 if the snap $snap wants snapshots in timeframe $tframe and return
746             # 0 otherwise;
747              
748 33     33 0 950 arg_count_or_die(3, 3, @_);
749              
750 33         38 my $snap = shift;
751 33         34 my $tframe = shift;
752 33         34 my $config_ref = shift;
753              
754 33         62 snap_exists_or_die($snap, $config_ref);
755 32         56 is_timeframe_or_die($tframe);
756              
757 30 100       47 return 1 if grep { $tframe eq $_ } snap_timeframes($snap, $config_ref);
  102         216  
758 12         24 return 0;
759             }
760              
761             sub snap_wants_timeframe_or_die {
762              
763             # Wrapper around &snap_wants_timeframe that Carp::Confess's if it returns
764             # false.
765              
766 29     29 0 877 arg_count_or_die(3, 3, @_);
767              
768 29         32 my $snap = shift;
769 29         44 my $tframe = shift;
770 29         32 my $config_ref = shift;
771              
772 29 100       45 unless ( snap_wants_timeframe($snap, $tframe, $config_ref) ) {
773 11         84 confess("yabsm: internal error: snap '$snap' is not taking $tframe snapshots");
774             }
775              
776 17         35 return 1;
777             }
778              
779             sub ssh_backup_wants_timeframe {
780              
781             # Return 1 if the ssh_backup $ssh_backup wants backups in timeframe $tframe
782             # and return 0 otherwise.
783              
784 33     33 0 846 arg_count_or_die(3, 3, @_);
785              
786 33         37 my $ssh_backup = shift;
787 33         35 my $tframe = shift;
788 33         34 my $config_ref = shift;
789              
790 33         54 ssh_backup_exists_or_die($ssh_backup, $config_ref);
791 32         55 is_timeframe_or_die($tframe);
792              
793 30 100       104 return 1 if grep { $tframe eq $_ } ssh_backup_timeframes($ssh_backup, $config_ref);
  102         211  
794 12         27 return 0;
795             }
796              
797             sub ssh_backup_wants_timeframe_or_die {
798              
799             # Wrapper around &ssh_backup_wants_timeframe that Carp::Confess's if it
800             # returns false.
801              
802 29     29 0 883 arg_count_or_die(3, 3, @_);
803              
804 29         32 my $ssh_backup = shift;
805 29         28 my $tframe = shift;
806 29         32 my $config_ref = shift;
807              
808 29 100       47 unless ( ssh_backup_wants_timeframe($ssh_backup, $tframe, $config_ref) ) {
809 11         94 confess("yabsm: internal error: ssh_backup '$ssh_backup' is not taking $tframe backups");
810             }
811              
812 17         44 return 1;
813             }
814              
815             sub local_backup_wants_timeframe {
816              
817             # Return 1 if the local_backup $local_backup wants backups in timeframe
818             # $tframe and return 0 otherwise.
819              
820 33     33 0 925 arg_count_or_die(3, 3, @_);
821              
822 33         34 my $local_backup = shift;
823 33         34 my $tframe = shift;
824 33         33 my $config_ref = shift;
825              
826 33         58 local_backup_exists_or_die($local_backup, $config_ref);
827              
828 32         54 is_timeframe_or_die($tframe);
829              
830 30 100       50 return 1 if grep { $tframe eq $_ } local_backup_timeframes($local_backup, $config_ref);
  102         188  
831 12         27 return 0;
832             }
833              
834             sub local_backup_wants_timeframe_or_die {
835              
836             # Wrapper around &local_backup_wants_timeframe that Carp::Confess's if it
837             # returns false.
838              
839 29     29 0 906 arg_count_or_die(3, 3, @_);
840              
841 29         36 my $local_backup = shift;
842 29         30 my $tframe = shift;
843 29         31 my $config_ref = shift;
844              
845 29 100       43 unless ( local_backup_wants_timeframe($local_backup, $tframe, $config_ref) ) {
846 11         88 confess("yabsm: internal error: local_backup '$local_backup' is not taking $tframe backups");
847             }
848              
849 17         65 return 1;
850             }
851              
852             sub snap_timeframe_keep {
853              
854             # Return snap $snap's ${tframe}_keep value.
855              
856 7     7 0 806 arg_count_or_die(3, 3, @_);
857              
858 7         12 my $snap = shift;
859 7         16 my $tframe = shift;
860 7         8 my $config_ref = shift;
861              
862 7         16 snap_exists_or_die($snap, $config_ref);
863 6         11 is_timeframe_or_die($tframe);
864              
865 5 100       17 $tframe eq '5minute' and return snap_5minute_keep($snap, $config_ref);
866 4 100       11 $tframe eq 'hourly' and return snap_hourly_keep($snap, $config_ref);
867 3 100       9 $tframe eq 'daily' and return snap_daily_keep($snap, $config_ref);
868 2 100       11 $tframe eq 'weekly' and return snap_weekly_keep($snap, $config_ref);
869 1 50       7 $tframe eq 'monthly' and return snap_monthly_keep($snap, $config_ref);
870             }
871              
872             sub snap_5minute_keep {
873              
874             # Return snap $snap's 5minute_keep value.
875              
876 4     4 0 1013 arg_count_or_die(2, 2, @_);
877              
878 4         4 my $snap = shift;
879 4         7 my $config_ref = shift;
880              
881 4         10 snap_exists_or_die($snap, $config_ref);
882 3         8 snap_wants_timeframe_or_die($snap, '5minute', $config_ref);
883              
884 2         14 return $config_ref->{snaps}{$snap}{'5minute_keep'};
885             }
886              
887             sub snap_hourly_keep {
888              
889             # Return snap $snap's hourly_keep value.
890              
891 4     4 0 733 arg_count_or_die(2, 2, @_);
892              
893 4         5 my $snap = shift;
894 4         5 my $config_ref = shift;
895              
896 4         10 snap_exists_or_die($snap, $config_ref);
897 3         8 snap_wants_timeframe_or_die($snap, 'hourly', $config_ref);
898              
899 2         12 return $config_ref->{snaps}{$snap}{hourly_keep};
900             }
901              
902             sub snap_daily_keep {
903              
904             # Return snap $snap's daily_keep value.
905              
906 4     4 0 820 arg_count_or_die(2, 2, @_);
907              
908 4         4 my $snap = shift;
909 4         6 my $config_ref = shift;
910              
911 4         9 snap_exists_or_die($snap, $config_ref);
912 3         6 snap_wants_timeframe_or_die($snap, 'daily', $config_ref);
913              
914 2         10 return $config_ref->{snaps}{$snap}{daily_keep};
915             }
916              
917             sub snap_daily_times {
918              
919             # Return a list of snap $snap's daily_times values.
920              
921 3     3 0 717 arg_count_or_die(2, 2, @_);
922              
923 3         5 my $snap = shift;
924 3         4 my $config_ref = shift;
925              
926 3         5 snap_exists_or_die($snap, $config_ref);
927 2         4 snap_wants_timeframe_or_die($snap, 'daily', $config_ref);
928              
929 1         5 my @times = split ',', $config_ref->{snaps}{$snap}{daily_times};
930              
931             # removes duplicates
932 1         2 @times = sort keys %{{ map { $_ => 1 } @times }};
  1         2  
  3         11  
933              
934             return @times
935 1         8 }
936              
937             sub snap_weekly_keep {
938              
939             # Return snap $snap's weekly_keep value.
940              
941 4     4 0 834 arg_count_or_die(2, 2, @_);
942              
943 4         4 my $snap = shift;
944 4         5 my $config_ref = shift;
945              
946 4         9 snap_exists_or_die($snap, $config_ref);
947 3         8 snap_wants_timeframe_or_die($snap, 'weekly', $config_ref);
948              
949 2         10 return $config_ref->{snaps}{$snap}{weekly_keep};
950             }
951              
952             sub snap_weekly_time {
953              
954             # Return snap $snap's weekly_time value.
955              
956 3     3 0 735 arg_count_or_die(2, 2, @_);
957              
958 3         4 my $snap = shift;
959 3         3 my $config_ref = shift;
960              
961 3         7 snap_exists_or_die($snap, $config_ref);
962 2         4 snap_wants_timeframe_or_die($snap, 'weekly', $config_ref);
963              
964 1         4 return $config_ref->{snaps}{$snap}{weekly_time};
965             }
966              
967             sub snap_weekly_day {
968              
969             # Return snap $snap's weekly_day value.
970              
971 3     3 0 760 arg_count_or_die(2, 2, @_);
972              
973 3         3 my $snap = shift;
974 3         29 my $config_ref = shift;
975              
976 3         9 snap_exists_or_die($snap, $config_ref);
977 2         4 snap_wants_timeframe_or_die($snap, 'weekly', $config_ref);
978              
979 1         5 return $config_ref->{snaps}{$snap}{weekly_day};
980             }
981              
982             sub snap_monthly_keep {
983              
984             # Return snap $snap's monthly_keep value.
985              
986 4     4 0 723 arg_count_or_die(2, 2, @_);
987              
988 4         6 my $snap = shift;
989 4         5 my $config_ref = shift;
990              
991 4         8 snap_exists_or_die($snap, $config_ref);
992 3         6 snap_wants_timeframe_or_die($snap, 'monthly', $config_ref);
993              
994 2         11 return $config_ref->{snaps}{$snap}{monthly_keep};
995             }
996              
997             sub snap_monthly_time {
998              
999             # Return snap $snap's monthly_time value.
1000              
1001 3     3 0 743 arg_count_or_die(2, 2, @_);
1002              
1003 3         4 my $snap = shift;
1004 3         4 my $config_ref = shift;
1005              
1006 3         5 snap_exists_or_die($snap, $config_ref);
1007 2         3 snap_wants_timeframe_or_die($snap, 'monthly', $config_ref);
1008              
1009 1         5 return $config_ref->{snaps}{$snap}{monthly_time};
1010             }
1011              
1012             sub snap_monthly_day {
1013              
1014             # Return snap $snap's monthly_day value.
1015              
1016 3     3 0 766 arg_count_or_die(2, 2, @_);
1017              
1018 3         3 my $snap = shift;
1019 3         4 my $config_ref = shift;
1020              
1021 3         7 snap_exists_or_die($snap, $config_ref);
1022 2         5 snap_wants_timeframe_or_die($snap, 'monthly', $config_ref);
1023              
1024 1         5 return $config_ref->{snaps}{$snap}{monthly_day};
1025             }
1026              
1027             sub ssh_backup_timeframe_keep {
1028              
1029             # Return ssh_backup $ssh_backup's ${tframe}_keep value.
1030              
1031 7     7 0 787 arg_count_or_die(3, 3, @_);
1032              
1033 7         7 my $ssh_backup = shift;
1034 7         8 my $tframe = shift;
1035 7         8 my $config_ref = shift;
1036              
1037 7         14 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1038 6         12 is_timeframe_or_die($tframe);
1039              
1040 5 100       23 $tframe eq '5minute' and return ssh_backup_5minute_keep($ssh_backup, $config_ref);
1041 4 100       7 $tframe eq 'hourly' and return ssh_backup_hourly_keep($ssh_backup, $config_ref);
1042 3 100       6 $tframe eq 'daily' and return ssh_backup_daily_keep($ssh_backup, $config_ref);
1043 2 100       8 $tframe eq 'weekly' and return ssh_backup_weekly_keep($ssh_backup, $config_ref);
1044 1 50       4 $tframe eq 'monthly' and return ssh_backup_monthly_keep($ssh_backup, $config_ref);
1045             }
1046              
1047             sub ssh_backup_5minute_keep {
1048              
1049             # Return ssh_backup $ssh_backup's 5minute_keep value.
1050              
1051 4     4 0 734 arg_count_or_die(2, 2, @_);
1052              
1053 4         5 my $ssh_backup = shift;
1054 4         16 my $config_ref = shift;
1055              
1056 4         9 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1057 3         7 ssh_backup_wants_timeframe_or_die($ssh_backup, '5minute', $config_ref);
1058              
1059 2         10 return $config_ref->{ssh_backups}{$ssh_backup}{'5minute_keep'};
1060             }
1061              
1062             sub ssh_backup_hourly_keep {
1063              
1064             # Return ssh_backup $ssh_backup's hourly_keep value.
1065              
1066 4     4 0 824 arg_count_or_die(2, 2, @_);
1067              
1068 4         4 my $ssh_backup = shift;
1069 4         5 my $config_ref = shift;
1070              
1071 4         9 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1072 3         6 ssh_backup_wants_timeframe_or_die($ssh_backup, 'hourly', $config_ref);
1073              
1074 2         15 return $config_ref->{ssh_backups}{$ssh_backup}{hourly_keep};
1075             }
1076              
1077             sub ssh_backup_daily_keep {
1078              
1079             # Return ssh_backup $ssh_backup's daily_keep value.
1080              
1081 4     4 0 723 arg_count_or_die(2, 2, @_);
1082              
1083 4         4 my $ssh_backup = shift;
1084 4         7 my $config_ref = shift;
1085              
1086 4         7 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1087 3         7 ssh_backup_wants_timeframe_or_die($ssh_backup, 'daily', $config_ref);
1088              
1089 2         10 return $config_ref->{ssh_backups}{$ssh_backup}{daily_keep};
1090             }
1091              
1092             sub ssh_backup_daily_times {
1093              
1094             # Return a list of ssh_backup $ssh_backup's daily_times values.
1095              
1096 3     3 0 748 arg_count_or_die(2, 2, @_);
1097              
1098 3         3 my $ssh_backup = shift;
1099 3         4 my $config_ref = shift;
1100              
1101 3         7 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1102 2         3 ssh_backup_wants_timeframe_or_die($ssh_backup, 'daily', $config_ref);
1103              
1104 1         3 my @times = split ',', $config_ref->{ssh_backups}{$ssh_backup}{daily_times};
1105              
1106             # removes duplicates
1107 1         2 @times = sort keys %{{ map { $_ => 1 } @times }};
  1         2  
  3         8  
1108              
1109 1         7 return @times;
1110             }
1111              
1112             sub ssh_backup_weekly_keep {
1113              
1114             # Return ssh_backup $ssh_backup's weekly_keep value.
1115              
1116 4     4 0 720 arg_count_or_die(2, 2, @_);
1117              
1118 4         6 my $ssh_backup = shift;
1119 4         5 my $config_ref = shift;
1120              
1121 4         7 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1122 3         7 ssh_backup_wants_timeframe_or_die($ssh_backup, 'weekly', $config_ref);
1123              
1124 2         8 return $config_ref->{ssh_backups}{$ssh_backup}{weekly_keep};
1125             }
1126              
1127             sub ssh_backup_weekly_time {
1128              
1129             # Return ssh_backup $ssh_backup's weekly_time value.
1130              
1131 3     3 0 765 arg_count_or_die(2, 2, @_);
1132              
1133 3         4 my $ssh_backup = shift;
1134 3         3 my $config_ref = shift;
1135              
1136 3         7 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1137 2         8 ssh_backup_wants_timeframe_or_die($ssh_backup, 'weekly', $config_ref);
1138              
1139 1         5 return $config_ref->{ssh_backups}{$ssh_backup}{weekly_time};
1140             }
1141              
1142             sub ssh_backup_weekly_day {
1143              
1144             # Return ssh_backup $ssh_backup's weekly_day value.
1145              
1146 3     3 0 807 arg_count_or_die(2, 2, @_);
1147              
1148 3         4 my $ssh_backup = shift;
1149 3         4 my $config_ref = shift;
1150              
1151 3         6 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1152 2         4 ssh_backup_wants_timeframe_or_die($ssh_backup, 'weekly', $config_ref);
1153              
1154 1         6 return $config_ref->{ssh_backups}{$ssh_backup}{weekly_day};
1155             }
1156              
1157             sub ssh_backup_monthly_keep {
1158              
1159             # Return ssh_backup $ssh_backup's monthly_keep value.
1160              
1161 4     4 0 791 arg_count_or_die(2, 2, @_);
1162              
1163 4         4 my $ssh_backup = shift;
1164 4         6 my $config_ref = shift;
1165              
1166 4         12 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1167 3         5 ssh_backup_wants_timeframe_or_die($ssh_backup, 'monthly', $config_ref);
1168              
1169 2         10 return $config_ref->{ssh_backups}{$ssh_backup}{monthly_keep};
1170             }
1171              
1172             sub ssh_backup_monthly_time {
1173              
1174             # Return ssh_backup $ssh_backup's monthly_time value.
1175              
1176 3     3 0 741 arg_count_or_die(2, 2, @_);
1177              
1178 3         3 my $ssh_backup = shift;
1179 3         5 my $config_ref = shift;
1180              
1181 3         5 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1182 2         5 ssh_backup_wants_timeframe_or_die($ssh_backup, 'monthly', $config_ref);
1183              
1184 1         5 return $config_ref->{ssh_backups}{$ssh_backup}{monthly_time};
1185             }
1186              
1187             sub ssh_backup_monthly_day {
1188              
1189             # Return ssh_backup $ssh_backup's monthly_day value.
1190              
1191 3     3 0 750 arg_count_or_die(2, 2, @_);
1192              
1193 3         3 my $ssh_backup = shift;
1194 3         4 my $config_ref = shift;
1195              
1196 3         7 ssh_backup_exists_or_die($ssh_backup, $config_ref);
1197 2         7 ssh_backup_wants_timeframe_or_die($ssh_backup, 'monthly', $config_ref);
1198              
1199 1         5 return $config_ref->{ssh_backups}{$ssh_backup}{monthly_day};
1200             }
1201              
1202             sub local_backup_timeframe_keep {
1203              
1204             # Return local_backup $local_backup's ${tframe}_keep value.
1205              
1206 7     7 0 842 arg_count_or_die(3, 3, @_);
1207              
1208 7         10 my $local_backup = shift;
1209 7         9 my $tframe = shift;
1210 7         8 my $config_ref = shift;
1211              
1212 7         15 local_backup_exists_or_die($local_backup, $config_ref);
1213 6         11 is_timeframe_or_die($tframe);
1214              
1215 5 100       11 $tframe eq '5minute' and return local_backup_5minute_keep($local_backup, $config_ref);
1216 4 100       10 $tframe eq 'hourly' and return local_backup_hourly_keep($local_backup, $config_ref);
1217 3 100       8 $tframe eq 'daily' and return local_backup_daily_keep($local_backup, $config_ref);
1218 2 100       8 $tframe eq 'weekly' and return local_backup_weekly_keep($local_backup, $config_ref);
1219 1 50       6 $tframe eq 'monthly' and return local_backup_monthly_keep($local_backup, $config_ref);
1220             }
1221              
1222             sub local_backup_5minute_keep {
1223              
1224             # Return local_backup $local_backup's 5minute_keep value.
1225              
1226 4     4 0 800 arg_count_or_die(2, 2, @_);
1227              
1228 4         5 my $local_backup = shift;
1229 4         6 my $config_ref = shift;
1230              
1231 4         8 local_backup_exists_or_die($local_backup, $config_ref);
1232 3         9 local_backup_wants_timeframe_or_die($local_backup, '5minute', $config_ref);
1233              
1234 2         12 return $config_ref->{local_backups}{$local_backup}{'5minute_keep'};
1235             }
1236              
1237             sub local_backup_hourly_keep {
1238              
1239             # Return local_backup $local_backup's hourly_keep value.
1240              
1241 4     4 0 751 arg_count_or_die(2, 2, @_);
1242              
1243 4         6 my $local_backup = shift;
1244 4         4 my $config_ref = shift;
1245              
1246 4         9 local_backup_exists_or_die($local_backup, $config_ref);
1247 3         7 local_backup_wants_timeframe_or_die($local_backup, 'hourly', $config_ref);
1248              
1249 2         12 return $config_ref->{local_backups}{$local_backup}{hourly_keep};
1250             }
1251              
1252             sub local_backup_daily_keep {
1253              
1254             # Return local_backup $local_backup's daily_keep value.
1255              
1256 4     4 0 748 arg_count_or_die(2, 2, @_);
1257              
1258 4         4 my $local_backup = shift;
1259 4         6 my $config_ref = shift;
1260              
1261 4         8 local_backup_exists_or_die($local_backup, $config_ref);
1262 3         8 local_backup_wants_timeframe_or_die($local_backup, 'daily', $config_ref);
1263              
1264 2         19 return $config_ref->{local_backups}{$local_backup}{daily_keep};
1265             }
1266              
1267             sub local_backup_daily_times {
1268              
1269             # Return a list of local_backup $local_backup's daily_times values.
1270              
1271 3     3 0 745 arg_count_or_die(2, 2, @_);
1272              
1273 3         3 my $local_backup = shift;
1274 3         4 my $config_ref = shift;
1275              
1276 3         7 local_backup_exists_or_die($local_backup, $config_ref);
1277 2         5 local_backup_wants_timeframe_or_die($local_backup, 'daily', $config_ref);
1278              
1279 1         3 my @times = split ',', $config_ref->{local_backups}{$local_backup}{daily_times};
1280              
1281             # removes duplicates
1282 1         2 @times = sort keys %{{ map { $_ => 1 } @times }};
  1         3  
  3         9  
1283              
1284 1         9 return @times;
1285             }
1286              
1287             sub local_backup_weekly_keep {
1288              
1289             # Return local_backup $local_backup's weekly_keep value.
1290              
1291 4     4 0 743 arg_count_or_die(2, 2, @_);
1292              
1293 4         5 my $local_backup = shift;
1294 4         7 my $config_ref = shift;
1295              
1296 4         8 local_backup_exists_or_die($local_backup, $config_ref);
1297 3         7 local_backup_wants_timeframe_or_die($local_backup, 'weekly', $config_ref);
1298              
1299 2         10 return $config_ref->{local_backups}{$local_backup}{weekly_keep};
1300             }
1301              
1302             sub local_backup_weekly_time {
1303              
1304             # Return local_backup $local_backup's weekly_time value.
1305              
1306 3     3 0 782 arg_count_or_die(2, 2, @_);
1307              
1308 3         3 my $local_backup = shift;
1309 3         4 my $config_ref = shift;
1310              
1311 3         7 local_backup_exists_or_die($local_backup, $config_ref);
1312 2         4 local_backup_wants_timeframe_or_die($local_backup, 'weekly', $config_ref);
1313              
1314 1         5 return $config_ref->{local_backups}{$local_backup}{weekly_time};
1315             }
1316              
1317             sub local_backup_weekly_day {
1318              
1319             # Return local_backup $local_backup's weekly_day value.
1320              
1321 3     3 0 746 arg_count_or_die(2, 2, @_);
1322              
1323 3         4 my $local_backup = shift;
1324 3         4 my $config_ref = shift;
1325              
1326 3         7 local_backup_exists_or_die($local_backup, $config_ref);
1327 2         5 local_backup_wants_timeframe_or_die($local_backup, 'weekly', $config_ref);
1328              
1329 1         5 return $config_ref->{local_backups}{$local_backup}{weekly_day};
1330             }
1331              
1332             sub local_backup_monthly_keep {
1333              
1334             # Return local_backup $local_backup's monthly_keep value.
1335              
1336 4     4 0 748 arg_count_or_die(2, 2, @_);
1337              
1338 4         5 my $local_backup = shift;
1339 4         6 my $config_ref = shift;
1340              
1341 4         9 local_backup_exists_or_die($local_backup, $config_ref);
1342 3         8 local_backup_wants_timeframe_or_die($local_backup, 'monthly', $config_ref);
1343              
1344 2         10 return $config_ref->{local_backups}{$local_backup}{monthly_keep};
1345             }
1346              
1347             sub local_backup_monthly_time {
1348              
1349             # Return local_backup $local_backup's monthly_time value.
1350              
1351 3     3 0 749 arg_count_or_die(2, 2, @_);
1352              
1353 3         3 my $local_backup = shift;
1354 3         4 my $config_ref = shift;
1355              
1356 3         7 local_backup_exists_or_die($local_backup, $config_ref);
1357 2         5 local_backup_wants_timeframe_or_die($local_backup, 'monthly', $config_ref);
1358              
1359 1         6 return $config_ref->{local_backups}{$local_backup}{monthly_time};
1360             }
1361              
1362             sub local_backup_monthly_day {
1363              
1364             # Return local_backup $local_backup's monthly_day value.
1365              
1366 3     3 0 746 arg_count_or_die(2, 2, @_);
1367              
1368 3         4 my $local_backup = shift;
1369 3         3 my $config_ref = shift;
1370              
1371 3         7 local_backup_exists_or_die($local_backup, $config_ref);
1372 2         4 local_backup_wants_timeframe_or_die($local_backup, 'monthly', $config_ref);
1373              
1374 1         5 return $config_ref->{local_backups}{$local_backup}{monthly_day};
1375             }
1376              
1377             1;