contrib/directory-archive/sort-into-month-folder

   1 #!/usr/bin/perl -w
   2
   3 # Sort dumped consensuses, statuses, descriptors etc into per-month folders.
   4
   5 # Copyright (c) 2006, 2007, 2008 Peter Palfrader
   6 #
   7 # Permission is hereby granted, free of charge, to any person obtaining a copy
   8 # of this software and associated documentation files (the "Software"), to deal
   9 # in the Software without restriction, including without limitation the rights
  10 # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  11 # copies of the Software, and to permit persons to whom the Software is
  12 # furnished to do so, subject to the following conditions:
  13 #
  14 # The above copyright notice and this permission notice shall be included in
  15 # all copies or substantial portions of the Software.
  16 #
  17 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  18 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  19 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  20 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  21 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  22 # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
  23 # SOFTWARE.
  24
  25 use strict;
  26 use File::Find;
  27 use File::Basename;
  28 use File::stat;
  29 use Time::Local;
  30
  31
  32 my $cutofftime;
  33
  34
  35 sub wanted() {
  36         return unless -f;
  37         my $mtime = stat($_)->mtime;
  38         return if $mtime >= $cutofftime;
  39
  40         my (undef,undef,undef,undef,$mon,$year,undef,undef,undef) = gmtime $mtime;
  41
  42         my $bn = basename $_;
  43         my $dn = dirname $_;
  44         my @path = split /\//, $dn;
  45         $path[0] .= sprintf 's-%4d-%02d', 1900+$year, $mon+1;
  46         $dn = join '/', @path;
  47
  48         if (! -d $dn) {
  49                 my $p = '.';
  50                 for my $component (@path) {
  51                         $p .= '/'.$component;
  52                         if (! -d $p) {
  53                                 mkdir $p or die ("Cannot mkdir $p: $!\n");
  54                         };
  55                 };
  56         };
  57
  58         print "$_ -> $dn/$bn\n";
  59         rename $_, $dn.'/'.$bn or die ("Cannot rename $_ to $dn/$bn: $!\n");
  60 };
  61
  62 my (undef,undef,undef,undef,$mon,$year,undef,undef,undef) = gmtime(time - 5*24*3600);
  63 $cutofftime = timegm(0,0,0,1,$mon,$year);
  64 find(   {
  65                 wanted          => \&wanted,
  66                 no_chdir        => 1
  67         },
  68         'server-descriptor');
  69
  70 find(   {
  71                 wanted          => \&wanted,
  72                 no_chdir        => 1
  73         },
  74         'extra-info');