Fri, 18 Oct 2019 21:59:21 -0500
redundant
#!/usr/bin/env perl use 5.014; use warnings; use strict; use lib glob('~/.lib/perl5'); use Autofetch; use Time::Piece; use Path::Tiny; use Getopt::Long::Descriptive; sub main { my ($opt, $usage) = describe_options( 'archive-dir %o <directory> ...', ['dest|d=s' => 'destination path' => {default => '.'}], ['fileinto|F=s' => 'file into, a strftime format', {default => '%Y'}], ['age|a=i' => "minimum age in days for archival", {default => 60}], ['files|f' => "operate on plain files only"], [], ['yes|Y' => "actually move stuff"], ['help|h' => "print usage message and exit", {shortcircuit => 1}], {show_defaults => 1} ); print($usage->text), exit if $opt->help || !@ARGV; archive_dir($opt, $_) for @ARGV; } sub archive_dir { my $opt = shift; my $dir = path(shift); my $destdir = path($opt->dest); $destdir = $dir->child($destdir) if $destdir->is_relative; my $destfmt = $opt->fileinto; my $nowish = time; my $age = $opt->age * 24 * 60 * 60; my @work; for my $child ($dir->children) { next if $child->is_dir && ( $opt->files || $child eq $destdir || $child =~ /^(?:\d{4}|\d\d)$/ ); next if $opt->files && $child->basename =~ /^\./; my $mtime = $child->stat->mtime; next unless ($nowish - $mtime) >= $age; my $dest = $destdir->child(localtime($mtime)->strftime($destfmt)); push @work, [$dest, $child]; } my $lastdest = ''; for my $work (sort {$a->[0] cmp $b->[0]} @work) { my ($dest, $child) = @$work; say $lastdest = $dest if $dest ne $lastdest; say "\t$child"; next unless $opt->yes; $dest->mkpath; $child->move($dest . '/' . $child->relative($dir)); } } main();