mvdirnewest

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # mvdirnewest
   5 # File ID: ab0489f6-f744-11dd-ba4c-000475e441b9
   6 #
   7 # Syntax: mvdirnewest directory
   8 # Forandrer navnet på directoryen til den nyeste fila i trestrukturen under.
   9 # Brukes til å lage orden i gamle versjoner av ting som ligger slengende rundt.
  10 #
  11 # Character set: UTF-8
  12 # ©opyleft 1999– Øyvind A. Holm <sunny@sunbase.org>
  13 # License: GNU General Public License version 2 or later, see end of
  14 # file for legal stuff.
  15 #=======================================================================
  16
  17 use strict;
  18 use warnings;
  19 use Getopt::Long;
  20
  21 $| = 1;
  22
  23 our $Debug = 0;
  24
  25 our %Opt = (
  26
  27     'debug' => 0,
  28     'help' => 0,
  29     'verbose' => 0,
  30     'version' => 0,
  31
  32 );
  33
  34 our $progname = $0;
  35 $progname =~ s/^.*\/(.*?)$/$1/;
  36 our $VERSION = "0.00";
  37
  38 Getopt::Long::Configure("bundling");
  39 GetOptions(
  40
  41     "debug" => \$Opt{'debug'},
  42     "help|h" => \$Opt{'help'},
  43     "verbose|v+" => \$Opt{'verbose'},
  44     "version" => \$Opt{'version'},
  45
  46 ) || die("$progname: Option error. Use -h for help.\n");
  47
  48 $Opt{'debug'} && ($Debug = 1);
  49 $Opt{'help'} && usage(0);
  50 if ($Opt{'version'}) {
  51     print_version();
  52     exit(0);
  53 }
  54
  55 my $RetVal = 0;
  56
  57
  58 die("$progname: Unknown version of find(1) or program not found\n") unless (`find --version` =~ /GNU find/);
  59
  60 foreach (@ARGV) {
  61         $RetVal ||= process_dir($_);
  62 }
  63
  64 exit $RetVal;
  65
  66 sub process_dir {
  67         my $dir_name = shift;
  68         unless (-e $dir_name) {
  69                 warn("$progname: $dir_name: Directory not found\n");
  70                 return;
  71         }
  72         unless (-d $dir_name) {
  73                 warn("$progname: $dir_name: Not a directory\n");
  74                 return;
  75         }
  76         my $newest_date = 0;
  77         my $newest_file = "";
  78
  79         # FIXME: Dette med find er midlertidig (og kommer sikkert til å forbli her :)
  80         my @Files = `find "$dir_name" -type f`;
  81         unless (scalar @Files) {
  82                 warn("$progname: $dir_name: No files found in directory\n");
  83                 return;
  84         }
  85         foreach (@Files) {
  86                 chomp;
  87                 my $file_name = $_;
  88                 my @stat_array;
  89                 unless (@stat_array = stat($file_name)) {
  90                         warn("$progname: $file_name: Can’t stat file: $!\n");
  91                         return;
  92                 }
  93                 my $file_date = $stat_array[9];
  94                 if ($file_date > $newest_date) {
  95                         $newest_date = $file_date;
  96                         $newest_file = $file_name;
  97                 }
  98                 # printf("$file_name: %s\n", date2str($file_date));
  99         }
 100         my $new_name = sprintf("%s.%s", date2str($newest_date), $dir_name);
 101         if (-e $new_name) {
 102                 warn("$progname: $new_name: Directory entry already exists, skipping directory $dir_name");
 103                 return;
 104         } else {
 105                 # printf("Skulle til å rename(%s, %s)\n", $dir_name, $new_name);
 106                 rename($dir_name, $new_name) || warn("$dir_name: Can’t rename directory to $new_name: $!");
 107                 print("$progname: $dir_name → $new_name\n");
 108         }
 109         return(0);
 110 } # process_dir()
 111
 112 sub date2str {
 113         my @TA = gmtime(shift);
 114         return(sprintf("%04u%02u%02uT%02u%02u%02uZ", $TA[5]+1900, $TA[4]+1, $TA[3], $TA[2], $TA[1], $TA[0]));
 115 } # date2str()
 116
 117 sub print_version {
 118     # Print program version {{{
 119     print("$progname v$VERSION\n");
 120     # }}}
 121 } # print_version()
 122
 123 sub usage {
 124     # Send the help message to stdout {{{
 125     my $Retval = shift;
 126
 127     if ($Opt{'verbose'}) {
 128         print("\n");
 129         print_version();
 130     }
 131     print(<<END);
 132
 133 Usage: $progname directory [directory [...]]
 134
 135 The program scans the underlying tree structure and renames the directory
 136 to the date of the newest file.
 137
 138 Options:
 139
 140   -h, --help
 141     Show this help.
 142   -v, --verbose
 143     Increase level of verbosity. Can be repeated.
 144   --version
 145     Print version information.
 146   --debug
 147     Print debugging messages.
 148
 149 END
 150     exit($Retval);
 151     # }}}
 152 } # usage()
 153
 154 sub msg {
 155     # Print a status message to stderr based on verbosity level {{{
 156     my ($verbose_level, $Txt) = @_;
 157
 158     if ($Opt{'verbose'} >= $verbose_level) {
 159         print(STDERR "$progname: $Txt\n");
 160     }
 161     # }}}
 162 } # msg()
 163
 164 sub D {
 165     # Print a debugging message {{{
 166     $Debug || return;
 167     my @call_info = caller;
 168     chomp(my $Txt = shift);
 169     my $File = $call_info[1];
 170     $File =~ s#\\#/#g;
 171     $File =~ s#^.*/(.*?)$#$1#;
 172     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 173     return("");
 174     # }}}
 175 } # D()
 176
 177 __END__
 178
 179 # Plain Old Documentation (POD) {{{
 180
 181 =pod
 182
 183 =head1 NAME
 184
 185 mvdirnewest
 186
 187 =head1 SYNOPSIS
 188
 189 mvdirnewest directory [directory [...]]
 190
 191 =head1 DESCRIPTION
 192
 193 The program scans the underlying tree structure and renames the directory
 194 to the date of the newest file.
 195
 196 =head1 OPTIONS
 197
 198 =over 4
 199
 200 =item B<-h>, B<--help>
 201
 202 Print a brief help summary.
 203
 204 =item B<-v>, B<--verbose>
 205
 206 Increase level of verbosity. Can be repeated.
 207
 208 =item B<--version>
 209
 210 Print version information.
 211
 212 =item B<--debug>
 213
 214 Print debugging messages.
 215
 216 =back
 217
 218 =head1 AUTHOR
 219
 220 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 221
 222 =head1 COPYRIGHT
 223
 224 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 225 This is free software; see the file F<COPYING> for legalese stuff.
 226
 227 =head1 LICENCE
 228
 229 This program is free software: you can redistribute it and/or modify it
 230 under the terms of the GNU General Public License as published by the
 231 Free Software Foundation, either version 2 of the License, or (at your
 232 option) any later version.
 233
 234 This program is distributed in the hope that it will be useful, but
 235 WITHOUT ANY WARRANTY; without even the implied warranty of
 236 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 237 See the GNU General Public License for more details.
 238
 239 You should have received a copy of the GNU General Public License along
 240 with this program.
 241 If not, see L<http://www.gnu.org/licenses/>.
 242
 243 =head1 SEE ALSO
 244
 245 =cut
 246
 247 # }}}
 248
 249 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :