comparison: bin/archive-dir
bin/archive-dir
- changeset 549
- 0bd45054802e
- parent 529
- 99f120bc1ad9
- child 677
- 15d353917450
equal
deleted
inserted
replaced
| 548:e34f183fbd55 | 549:0bd45054802e |
|---|---|
| 1 #!/usr/bin/env perl | 1 #!/usr/bin/env perl |
| 2 | 2 use 5.014; |
| 3 use warnings; | 3 use warnings; |
| 4 use strict; | 4 use strict; |
| 5 use Time::Piece; | 5 use Time::Piece; |
| 6 use Path::Tiny; | 6 use Path::Tiny; |
| 7 use Getopt::Long::Descriptive; | 7 use Getopt::Long::Descriptive; |
| 35 $destdir = $dir->child($destdir) if $destdir->is_relative; | 35 $destdir = $dir->child($destdir) if $destdir->is_relative; |
| 36 my $destfmt = ($opt->subdir eq 'month') ? '%Y-%m' : '%Y'; | 36 my $destfmt = ($opt->subdir eq 'month') ? '%Y-%m' : '%Y'; |
| 37 my $nowish = time; | 37 my $nowish = time; |
| 38 my $age = $opt->age * 24 * 60 * 60; | 38 my $age = $opt->age * 24 * 60 * 60; |
| 39 | 39 |
| 40 my @work; | |
| 41 | |
| 40 for my $child ($dir->children) { | 42 for my $child ($dir->children) { |
| 41 next if $child->is_dir && ( | 43 next if $child->is_dir && ( |
| 42 $opt->files || $child eq $destdir || $child =~ /^(?:\d{4}|\d\d)$/ | 44 $opt->files || $child eq $destdir || $child =~ /^(?:\d{4}|\d\d)$/ |
| 43 ); | 45 ); |
| 44 next if $opt->files && $child->basename =~ /^\./; | 46 next if $opt->files && $child->basename =~ /^\./; |
| 45 | 47 |
| 46 my $mtime = $child->stat->mtime; | 48 my $mtime = $child->stat->mtime; |
| 47 next unless ($nowish - $mtime) >= $age; | 49 next unless ($nowish - $mtime) >= $age; |
| 48 | 50 |
| 49 my $dest = $destdir->child(localtime($mtime)->strftime($destfmt)); | 51 my $dest = $destdir->child(localtime($mtime)->strftime($destfmt)); |
| 52 push @work, [$dest, $child]; | |
| 53 } | |
| 50 | 54 |
| 51 print "$dest \t $child\n"; | 55 my $lastdest = ''; |
| 56 for my $work (sort {$a->[0] cmp $b->[0]} @work) { | |
| 57 my ($dest, $child) = @$work; | |
| 58 | |
| 59 say $lastdest = $dest | |
| 60 if $dest ne $lastdest; | |
| 61 | |
| 62 say "\t$child"; | |
| 52 | 63 |
| 53 next unless $opt->yes; | 64 next unless $opt->yes; |
| 54 $dest->mkpath; | 65 $dest->mkpath; |
| 55 $child->move($dest . '/' . $child->relative($dir)); | 66 $child->move($dest . '/' . $child->relative($dir)); |
| 56 } | 67 } |
