"Fossies" - the Fresh Open Source Software Archive

Member "dirvish-1.2.1/dirvish-locate.pl" (19 Feb 2005, 5409 Bytes) of package /linux/privat/old/dirvish-1.2.1.tgz:

    1 #       $Id: dirvish-locate.pl,v 12.0 2004/02/25 02:42:14 jw Exp $  $Name: Dirvish-1_2 $
    2 
    3 $VERSION = ('$Name: Dirvish-1_2 $' =~ /Dirvish/i)
    4     ? ('$Name: Dirvish-1_2 $' =~ m/^.*:\s+dirvish-(.*)\s*\$$/i)[0]
    5     : '1.1.2 patch' . ('$Id: dirvish-locate.pl,v 12.0 2004/02/25 02:42:14 jw Exp $'
    6         =~ m/^.*,v(.*:\d\d)\s.*$/)[0];
    7 $VERSION =~ s/_/./g;
    8 
    9 
   10 #########################################################################
   11 #                                                               #
   12 #   Copyright 2003 and $Date: 2004/02/25 02:42:14 $
   13 #                         Pegasystems Technologies and J.W. Schultz     #
   14 #                                                               #
   15 #   Licensed under the Open Software License version 2.0        #
   16 #                                                               #
   17 #   This program is free software; you can redistribute it      #
   18 #   and/or modify it under the terms of the Open Software       #
   19 #   License, version 2.0 by Lauwrence E. Rosen.         #
   20 #                                                               #
   21 #   This program is distributed in the hope that it will be     #
   22 #   useful, but WITHOUT ANY WARRANTY; without even the implied  #
   23 #   warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR     #
   24 #   PURPOSE.  See the Open Software License for details.        #
   25 #                                                               #
   26 #########################################################################
   27 
   28 use Time::ParseDate;
   29 use POSIX qw(strftime);
   30 use File::Find;
   31 use Getopt::Long;
   32 
   33 sub loadconfig;
   34 sub check_expire;
   35 sub findop;
   36 sub imsort;
   37 sub seppuku;
   38 
   39 $KILLCOUNT = 1000;
   40 $MAXCOUNT = 100;
   41 
   42 sub usage
   43 {
   44     my $message = shift(@_);
   45 
   46     length($message) and print STDERR $message, "\n\n";
   47 
   48     print STDERR <<EOUSAGE;
   49 USAGE
   50     dirvish-locate vault[:branch] pattern
   51     
   52 EOUSAGE
   53 
   54     exit 255;
   55 }
   56 
   57 $Options = 
   58 { 
   59     help        => \&usage,
   60     version     => sub {
   61             print STDERR "dirvish version $VERSION\n";
   62             exit(0);
   63         },
   64 };
   65 
   66 if ($CONFDIR =~ /dirvish$/ && -f "$CONFDIR.conf")
   67 {
   68     loadconfig(undef, "$CONFDIR.conf", $Options);
   69 }
   70 elsif (-f "$CONFDIR/master.conf")
   71 {
   72     loadconfig(undef, "$CONFDIR/master.conf", $Options);
   73 }
   74 elsif (-f "$CONFDIR/dirvish.conf")
   75 {
   76     seppuku 250, <<EOERR;
   77 ERROR: no master configuration file.
   78     An old $CONFDIR/dirvish.conf file found.
   79     Please read the dirvish release notes.
   80 EOERR
   81 }
   82 else
   83 {
   84     seppuku 251, "ERROR: no global configuration file";
   85 }
   86 
   87 GetOptions($Options, qw(
   88     version
   89     help|?
   90     )) or usage;
   91 
   92 $Vault = shift;
   93 $Vault =~ /:/ and ($Vault, $Branch) = split(/:/, $Vault);
   94 $Pattern = shift;
   95 
   96 $Vault && length($Pattern) or usage;
   97 
   98 $fullpattern = $Pattern;
   99 $fullpattern =~ /\$$/ or $fullpattern .= '[^/]*$';
  100 ($partpattern = $fullpattern) =~ s/^\^//;
  101 
  102 for $b (@{$$Options{bank}})
  103 {
  104     -d "$b/$Vault" and $bank = $b;
  105 }
  106 $bank or seppuku 220, "No such vault: $Vault";
  107 
  108 opendir VAULT, "$bank/$Vault" or seppuku 221, "cannot open vault: $Vault";
  109 @invault = readdir(VAULT);
  110 closedir VAULT;
  111 
  112 for $image (@invault)
  113 {
  114     $image eq 'dirvish' and next;
  115     $imdir = "$bank/$Vault/$image";
  116     -f "$imdir/summary" or next;
  117     $conf = loadconfig('R', "$imdir/summary") or next;
  118     $$conf{Status} eq 'success' || $$conf{Status} =~ /^warn/
  119         or next;
  120     $$conf{'Backup-complete'} or next;
  121     $Branch && $$conf{branch} ne $Branch and next;
  122 
  123     unshift @images, {
  124         imdir => $imdir,
  125         image => $$conf{Image},
  126         branch => $$conf{branch},
  127         created => $$conf{'Backup-complete'},
  128         }
  129 }
  130 
  131 for $image (sort(imsort @images))
  132 {
  133     $imdir = $$image{imdir};
  134 
  135     $index = undef;
  136     -f "$imdir/index.bz2" and $index = "bzip2 -d -c $imdir/index.bz2|";
  137     -f "$imdir/index.gz" and $index = "gzip -d -c $imdir/index|";
  138     -f "$imdir/index" and $index = "<$imdir/index";
  139     $index or next;
  140 
  141     ++$imagecount;
  142 
  143     open INDEX, $index or next;
  144     while (<INDEX>)
  145     {
  146         chomp;
  147 
  148         m($partpattern) or next;
  149 
  150 # this parse operation is too slow.  It might be faster as a
  151 # split with trimmed leading whitespace and remerged modtime
  152         $f = { image => $image };
  153         (
  154             $$f{inode},
  155             $$f{blocks},
  156             $$f{perms},
  157             $$f{links},
  158             $$f{owner},
  159             $$f{group},
  160             $$f{bytes},
  161             $$f{mtime},
  162             $path
  163         ) = m<^
  164             \s*(\S+)        # inode
  165             \s+(\S+)        # block count
  166             \s+(\S+)        # perms
  167             \s+(\S+)        # link count
  168             \s+(\S+)        # owner
  169             \s+(\S+)        # group
  170             \s+(\S+)        # byte count
  171             \s+(\S+\s+\S+\s+\S+)    # date
  172             \s+(\S.*)       # path
  173         $>x;
  174         $$f{perms} =~ /^[dl]/ and next;
  175         $path =~ m($fullpattern) or next;
  176 
  177         exists($match{$path}) or ++$pathcount;
  178         push @{$match{$path}}, $f;
  179     }
  180     if ($pathcount >= $KILLCOUNT)
  181     {
  182         printf "dirvish-locate: too many paths match pattern, interupting search\n";
  183         last;
  184     }
  185 }
  186 
  187 printf "%d matches in %d images\n", $pathcount, $imagecount;
  188 $pathcount >= $MAXCOUNT
  189     and printf "Pattern '%s' too vague, listing paths only.\n",
  190         $Pattern;
  191 
  192 for $path (sort(keys(%match)))
  193 {
  194     $last = undef;
  195     print $path;
  196 
  197     if ($pathcount >= $MAXCOUNT)
  198     {
  199         print "\n";
  200             next;
  201     }
  202 
  203     for $hit (@{$match{$path}})
  204     {
  205         $inode = $$hit{inode};
  206         $mtime = $$hit{mtime};
  207         $image = $$hit{image}{image};
  208         if ($inode ne $last)
  209         {
  210             $linesize = 5 + length($mtime) + length($image);
  211             printf "\n    %s %s", $mtime, $image;
  212         } else {
  213             $linesize += length($image) + 2;
  214             if ($linesize > 78)
  215             {
  216                 $linesize = 5 + length($mtime) + length($image);
  217                 print "\n",
  218                     " " x (5 + length($mtime)),
  219                     $image;
  220             } else {
  221                 printf ", %s", $$hit{image}{image};
  222             }
  223         }
  224         $last = $inode;
  225     }
  226     print "\n\n";
  227 }
  228 
  229 exit 0;
  230 
  231 sub imsort
  232 {
  233     $$a{branch} cmp $$b{branch}
  234     || $$b{created} cmp $$a{created};
  235 }
  236