comparison: bin/archive-dir
bin/archive-dir
- changeset 476
- 0938f35f78f9
- child 477
- eeafc178ddc4
equal
deleted
inserted
replaced
| 475:039e458c86cd | 476:0938f35f78f9 |
|---|---|
| 1 #!/usr/bin/env perl | |
| 2 | |
| 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}], | |
| 22 ['yes|y' => "actually move files"], | |
| 23 ['help|h' => "print usage message and exit", {shortcircuit => 1}], | |
| 24 ); | |
| 25 print($usage->text), exit if $opt->help; | |
| 26 | |
| 27 archive_dir($opt, $_) for @ARGV; | |
| 28 } | |
| 29 | |
| 30 sub archive_dir { | |
| 31 my $opt = shift; | |
| 32 my $dir = path(shift); | |
| 33 my $destdir = path($opt->dest // '.'); | |
| 34 $destdir = $dir->child($destdir) if $destdir->is_relative; | |
| 35 my $destfmt = ($opt->subdir eq 'month') ? '%Y-%m' : '%Y'; | |
| 36 my $nowish = time; | |
| 37 my $age = $opt->age * 24 * 60 * 60; | |
| 38 | |
| 39 for my $child ($dir->children) { | |
| 40 next if $child->is_dir && ($child eq $destdir || $child =~ /^(?:\d{4}|\d\d)$/); | |
| 41 | |
| 42 my $mtime = $child->stat->mtime; | |
| 43 next unless ($nowish - $mtime) >= $age; | |
| 44 | |
| 45 my $dest = $destdir->child(localtime($mtime)->strftime($destfmt)); | |
| 46 | |
| 47 print "$dest \t $child\n"; | |
| 48 | |
| 49 next unless $opt->yes; | |
| 50 $dest->mkpath; | |
| 51 $child->move($dest . '/' . $child->relative($dir)); | |
| 52 } | |
| 53 } | |
| 54 | |
| 55 main(); |
