afv_rename

   1 #!/usr/bin/env perl
   2
   3 #===============================================================
   4 # afv_rename
   5 # File ID: f7f4047c-5d36-11df-a766-90e6ba3022ac
   6 # Leser filnavn fra stdin og skifter navn på dem fra gammelt
   7 # afv-format (epoch) til ååååmmddTttmmssZ . Virker forsåvidt på
   8 # alle filer som begynner med et 9- eller 10-sifret nummer.
   9 #
  10 # Character set: UTF-8
  11 # License: GNU General Public License version 2 or later
  12 # ©opyleft 2004 Øyvind A. Holm <sunny@sunbase.org>
  13 #===============================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Std;
  18
  19 our ($opt_v) =
  20     (     0);
  21 getopts('v');
  22
  23 $| = 1;
  24
  25 while (<>) {
  26         chomp();
  27         if (/^(.*)\/([^\/]+?)$/) {
  28                 my ($Path, $File) =
  29                    (   $1,    $2);
  30
  31                 if ($File =~ /^(.*?)\b(\d{9,10})\b(.*)$/) {
  32                         my ($First, $Num, $Rest) =
  33                            (    $1,   $2,    $3);
  34                         my $From = "$Path/$File";
  35                         if (-f $From) {
  36                                 my @TA = gmtime($Num);
  37                                 my $date_str = sprintf("%04u%02u%02uT%02u%02u%02uZ", $TA[5]+1900, $TA[4]+1, $TA[3], $TA[2], $TA[1], $TA[0]);
  38                                 my $Dest = "$Path/$First$date_str$Rest";
  39                                 unless (-e $Dest) {
  40                                         if (rename($From, $Dest)) {
  41                                                 $opt_v && print("$From → $Dest\n");
  42                                         } else {
  43                                                 warn("rename(\"$From\", \"$Dest\"): $!\n");
  44                                         }
  45                                 } else {
  46                                         warn("$Dest: File exists.\n");
  47                                 }
  48                         } else {
  49                                 warn("Ignoring non-regular file $From\n");
  50                         }
  51                 }
  52         }
  53 }
  54
  55 __END__
  56
  57 =pod
  58
  59 =head1 LICENCE
  60
  61 This program is free software; you can redistribute it and/or modify it
  62 under the terms of the GNU General Public License as published by the
  63 Free Software Foundation; either version 2 of the License, or (at your
  64 option) any later version.
  65
  66 This program is distributed in the hope that it will be useful, but
  67 WITHOUT ANY WARRANTY; without even the implied warranty of
  68 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  69 See the GNU General Public License for more details.
  70
  71 You should have received a copy of the GNU General Public License along
  72 with this program; if not, write to the Free Software Foundation, Inc.,
  73 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  74
  75 =cut
  76
  77 # vim: set fileencoding=UTF-8 filetype=perl foldmethod=marker foldlevel=0 :
  78 # End of file afv_rename