#!/usr/bin/perl -w
#
# $Id: fbd,v 1.4 2003/08/01 02:10:56 jmates Exp $
#
# The author disclaims all copyrights and releases this script into the
# public domain.
#
# Finds files with same (or similar) modification times as specified
# file or user-supplied date.

require 5;
use strict;

my $VERSION;
($VERSION = '$Revision: 1.4 $ ') =~ s/[^0-9.]//g;

# what stat() colume to read time from (e.g. mtime, atime, ctime)
my $timef = 9;

use Getopt::Std;
my %opts;
getopts('h?f:d:a:b:p:s:', \%opts);
help() if exists $opts{'h'} or exists $opts{'?'};
help() unless @ARGV;

my $src_date;

if (exists $opts{d}) {
  $src_date = $opts{d} or die "error: could not parse empty date\n";

  # treat all numeric as epoch date, otherwise attempt to parse
  unless ($src_date =~ /^\d+/) {
    require Date::Parse;
    $src_date = Date::Parse::str2time($src_date);
    die "error: could not parse supplied date\n" unless $src_date;
  }

}

if (exists $opts{f}) {
  $src_date = (stat $opts{f})[$timef];
  die "error: could not read date from $opts{f}\n"
   if not $src_date
   or $src_date !~ /^\d+$/;
}

my $skip  = $opts{'s'} if exists $opts{'s'};
my $prune = $opts{'p'} if exists $opts{'p'};

my ($fudge, $min_date, $max_date);

if (exists $opts{a}) {
  $fudge    = duration2seconds($opts{a});
  $min_date = $src_date - $fudge;
  $max_date = $src_date + $fudge;
}
if (exists $opts{b}) {
  $fudge    = duration2seconds($opts{b});
  $min_date = $src_date - $fudge;
  $max_date = $src_date unless $max_date;
}

use File::Find;

for my $parent (@ARGV) {
  find {
    no_chdir => 1,
    wanted   => sub {
      my $file_date = (stat $_)[$timef];

      if ($prune and -d _) {
        my $result = eval "return 1 if (" . $prune . ");";

        if ($@) {
          chomp $@;
          die "error: prune eval failure: ", $@;  # croak on errors
        }

        if ($result) {
          $File::Find::prune = 1;
          return;
        }
      }

      if (
        (
          defined $fudge
          and ($file_date >= $min_date and $file_date <= $max_date)
        )
        or ($file_date eq $src_date)
       ) {

        if ($skip) {
          my $result = eval "return 1 if (" . $skip . ");";

          if ($@) {
            chomp $@;
            die "error: skip eval failure: ", $@;  # croak on errors
          }

          if ($result) {
            return;
          }
        }

        print $File::Find::name, "\n";
      }
     }
   },
   $parent
}

######################################################################
#
# SUBROUTINES

# takes duration such as "2m3s" and returns number of seconds.
sub duration2seconds {
  my $tmpdur = shift;
  my $seconds;

  # how to convert short human durations into seconds
  my %factor = (
    w => 604800,
    d => 86400,
    h => 3600,
    m => 60,
    s => 1,
  );

  # assume raw seconds for plain number
  if ($tmpdur =~ m/^\d+$/) {
    $seconds = $tmpdur * 60;

  } elsif ($tmpdur =~ m/^[wdhms\d\s]+$/) {

    # match "2m 5s" style input and convert to seconds
    while ($tmpdur =~ m/(\d+)\s*([wdhms])/g) {
      $seconds += $1 * $factor{$2};
    }
  } else {
    die "Error: unknown characters in duration.\n";
  }

  unless (defined $seconds and $seconds =~ m/^\d+$/) {
    die "Error: unable to parse duration.\n";
  }

  return $seconds;
}

# a generic help blarb
sub help {
  print <<"HELP";
Usage: $0 [opts] searchdir1 [sd2 .. sdN]

Finds files with similar date to specified date or file.

Options for version $VERSION:
  -h/-?  Display this message.

  -f ff  Read modify time to compare with from specified file.
  -d dd  Specify modify time manually.

  -a xx  Allow xx seconds or shorthand duration fuzz around lookup time.
  -b yy  Allow xx seconds before lookup (makes -a "after time")

  -s xx  Perl expression to skip files.
  -p xx  Perl expression to prune directories from search.

Run perldoc(1) on this script for additional documentation.

HELP
  exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

fbd - find files by date

=head1 SYNOPSIS

Find files in /etc with the same modification date as /etc/passwd.

  $ fbd -f /etc/passwd /etc

List files under /tmp and /var/tmp modified within five minutes of the
current date.

  $ fbd -d "`date`" -a 5m /tmp /var/tmp

=head1 DESCRIPTION

=head2 Overview

Provides means to list files under specified search directories that
have or have similar modification (mtime) dates set.

=head2 Normal Usage

  $ fbd [opts] searchdir1 [sd2 .. sdN]

See L<"OPTIONS"> for details on the command line switches supported.

Either a single or multiple search directories must be specified. Each
directory will be searched recursively. A date to search by must be
supplied either from a file with B<-f> or manually with B<-d>.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=item B<-f> I<file>

Read modification time from the specified file.

=item B<-d> I<date>

Uses specified time in epoch or Date::Parse-compatible format for the
value to compare other files with.

=item B<-a> I<duration>

Without B<-b>, allows files modified within I<duration> to match. The
duraction can either be in raw seconds or a short-hand "2m5s" format.
This means B<-a> I<3h> without B<-b> will match files modified within
three hours either side of the target date.  Mnemonic: "around."

With B<-b>, allows files modified I<duration> after the target
date to match.  Mnemonic: "after."

The short-hand duration notation supports w for weeks, d for days, h for
hours, m for minutes, and s for seconds. Multiple groups add together,
such that 1m1s1s adds up to 62 seconds.

=item B<-b> I<duration>

Allows files modified I<duration> before the target date to match.
Assuming no B<-a> is specified, B<-b> I<120> would match files modified
at the target date, or up to 120 seconds before that time.

=item B<-s> I<expression>

Perl expression that will result in the current item (stored in $_)
being skipped from being listed if the expression turns out to be true
and the file in question would otherwise match. Example:

  -s '-d _'

Would exclude directories from being matched, via the cached stat
information using the special _ notation.

=item B<-p> I<expression>

Perl expression that will result in the current directory (stored in
$_) and anything below that directory being "pruned" from the search.

For example, one can easily prune out all directories lower than the
one supplied as an argument by using the special $parent variable to
check against the current directory; essentially, this turns off the
default recursive behaviour of File::Find.

  -p '$parent ne $_'

=back

=head1 SECURITY

Disable or remove the -s and -p options if the script is used to perform
actions via sudo(8) or other user-changing methods, as the options in
question execute arbitrary perl code.

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 SEE ALSO

perl(1), Date::Parse

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

The author disclaims all copyrights and releases this script into the
public domain.

=head1 VERSION

  $Id: fbd,v 1.4 2003/08/01 02:10:56 jmates Exp $

=head1 SCRIPT CATEGORIES

Utilities
Unix/System_administration

=cut