Mon, 12 Jun 2017 17:20:38 -0400
smarter jk maps
476 | 1 | #!/usr/bin/env perl |
549
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
2 | use 5.014; |
476 | 3 | use warnings; |
4 | use strict; | |
5 | use Time::Piece; | |
6 | use Path::Tiny; | |
7 | use Getopt::Long::Descriptive; | |
8 | ||
9 | sub main { | |
10 | my ($opt, $usage) = describe_options( | |
11 | 'archive-dir %o <directory> ...', | |
12 | ['dest|d=s' => "destination path"], | |
13 | ['subdir' => hidden => { | |
14 | one_of => [ | |
15 | ['year|y' => 'file by year'], | |
16 | ['month|m' => 'file by month'], | |
17 | ], | |
18 | default => 'year', | |
19 | } | |
20 | ], | |
21 | ['age|a=i' => "minimum age in days for archival", {default => 60}], | |
477
eeafc178ddc4
add -f for only plain files
Meredith Howard <mhoward@roomag.org>
parents:
476
diff
changeset
|
22 | ['files|f' => "operate on plain files only"], |
529 | 23 | ['yes|Y' => "actually move stuff"], |
476 | 24 | ['help|h' => "print usage message and exit", {shortcircuit => 1}], |
25 | ); | |
485
a58682115510
print usage on no args too
Meredith Howard <mhoward@roomag.org>
parents:
477
diff
changeset
|
26 | print($usage->text), exit if $opt->help || !@ARGV; |
476 | 27 | |
28 | archive_dir($opt, $_) for @ARGV; | |
29 | } | |
30 | ||
31 | sub archive_dir { | |
32 | my $opt = shift; | |
33 | my $dir = path(shift); | |
34 | my $destdir = path($opt->dest // '.'); | |
35 | $destdir = $dir->child($destdir) if $destdir->is_relative; | |
36 | my $destfmt = ($opt->subdir eq 'month') ? '%Y-%m' : '%Y'; | |
37 | my $nowish = time; | |
38 | my $age = $opt->age * 24 * 60 * 60; | |
39 | ||
549
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
40 | my @work; |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
41 | |
476 | 42 | for my $child ($dir->children) { |
477
eeafc178ddc4
add -f for only plain files
Meredith Howard <mhoward@roomag.org>
parents:
476
diff
changeset
|
43 | next if $child->is_dir && ( |
eeafc178ddc4
add -f for only plain files
Meredith Howard <mhoward@roomag.org>
parents:
476
diff
changeset
|
44 | $opt->files || $child eq $destdir || $child =~ /^(?:\d{4}|\d\d)$/ |
eeafc178ddc4
add -f for only plain files
Meredith Howard <mhoward@roomag.org>
parents:
476
diff
changeset
|
45 | ); |
eeafc178ddc4
add -f for only plain files
Meredith Howard <mhoward@roomag.org>
parents:
476
diff
changeset
|
46 | next if $opt->files && $child->basename =~ /^\./; |
476 | 47 | |
48 | my $mtime = $child->stat->mtime; | |
49 | next unless ($nowish - $mtime) >= $age; | |
50 | ||
51 | my $dest = $destdir->child(localtime($mtime)->strftime($destfmt)); | |
549
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
52 | push @work, [$dest, $child]; |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
53 | } |
476 | 54 | |
549
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
55 | my $lastdest = ''; |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
56 | for my $work (sort {$a->[0] cmp $b->[0]} @work) { |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
57 | my ($dest, $child) = @$work; |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
58 | |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
59 | say $lastdest = $dest |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
60 | if $dest ne $lastdest; |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
61 | |
0bd45054802e
sort and format plan before working
Meredith Howard <mhoward@roomag.org>
parents:
529
diff
changeset
|
62 | say "\t$child"; |
476 | 63 | |
64 | next unless $opt->yes; | |
65 | $dest->mkpath; | |
66 | $child->move($dest . '/' . $child->relative($dir)); | |
67 | } | |
68 | } | |
69 | ||
70 | main(); |