Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Perl port of locate

by sifukurt (Hermit)
on Jul 19, 2001 at 18:41 UTC ( [id://98084]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Kurt Kincaid (sifukurt@yahoo.com)
Description: Personally, on a Linux system, I use locate very regularly. The problem is that I have a couple Win32 systems that I use, and, of course, there isn't a tool like locate. So I wrote this. I use it quite a bit, so I thought I'd share it here in the hopes that others would find it useful. I tried to be as compliant with the GNU locate command as possible, plus I added a few simple features that I needed but weren't part of the GNU locate specifications.

There are a few variables that you'll want to alter to suit the needs of your system. Comments welcome.
#!/usr/bin/perl

#--------------------------------------------------------------------#
# Perl Locate
#    A slightly modified perl port of the Linux locate command
#
#       Date Written:   5-Jun-2001 04:28:21 PM
#       Last Modified:  19-Jul-2001 08:09:38 AM
#       Author:    Kurt Kincaid
#       Copyright (c) 2001, Kurt Kincaid
#           All Rights Reserved
#
# NOTICE: This code is free software; you can redistribute it and/or 
#         modify it under the same terms as Perl itself, though it 
#         would be greatly appreciated if the original author 
#         information remains intact.
#--------------------------------------------------------------------#

use Getopt::Std;
use File::Find();
use Date::Manip;

$|  = 1;
chomp @ARGV;
$count = 0;
$VERSION       = "2.01";
$LAST_MODIFIED = "Thursday, July 19 2001 08:09:38 PM";

#--------------------------------------------------------------------#
# Start User Customize Section
#--------------------------------------------------------------------#
$TZ = "US/Central";
$databaseName = "files.idx";
$databaseDir  = "/kurt/files";
#--------------------------------------------------------------------#
# End User Customize Section
#--------------------------------------------------------------------#

getopts("uUvVihScl:");

if ( $opt_u || $opt_U ) {
    Update();
}

if ( $opt_S ) {
    $mod  = ( stat("$databaseDir/$databaseName" . "\.pag" ) )[9];
    $date = localtime( $mod );
    OpenDB();
    @files = keys %Files;
    $count = @files;
    CloseDB();
    $Count = Commas( $count );
    print ("Last Update: $date\n");
    print ("Files in Database: $Count\n");
    exit;
}

if ( $opt_V ) {
    Version();
}

if ( $opt_h || $ARGV[0] eq "" ) {
    Usage();
}

#--------------------------------------------------------------------#
# Begin Main Routine
#--------------------------------------------------------------------#
OpenDB();

if ( $opt_i ) {
    @files = grep { /$ARGV[0]/i } keys %Files;
} else {
    @files = grep { /$ARGV[0]/ } keys %Files;
}

foreach $file ( @files ) {
    $count++;
    if ( $opt_c ) {    next }
        
    if ( $opt_l ) {
        if ( $count <= $opt_l ) {
            Show();
        } else {
        last;
        }
    } else {
        Show();
    }
}

if ( $opt_c ) {
    print $count, "\n";
}

CloseDB();
exit;
#--------------------------------------------------------------------#
# End Main Routine
#--------------------------------------------------------------------#

sub Version {
    print <<END;
Locate v$VERSION by Kurt Kincaid (sifukurt\@yahoo.com)
A perl port of the Linux locate command, with minor modifications.
Last Modified:  $LAST_MODIFIED
END
    exit;
}

sub Update {
    OpenDB();
    use vars qw/*name *dir *prune/;
    *name  = *File::Find::name;
    *dir   = *File::Find::dir;
    *prune = *File::Find::prune;

    File::Find::find( { wanted => \&Wanted }, '/' );

    if ( $opt_U ) {
        $Count = Commas( $count );
        $mess = "Files Processed: $Count";
        print "\r$mess" . ( " " x ( 75 - length $mess ) );
    }
        
    foreach $file ( keys %Files ) {
        unless ( -e $file ) {
            $deleted++;
            delete $Files{$file};
        }
    }

    if ( $opt_U ) {
        $deleted = Commas( $deleted );
        if ( $deleted eq "" ) { $deleted = "0" }
        print ("\nDeleted Database Entries: $deleted\n");
    }

    CloseDB();
    exit;
}

sub Usage {
    print <<END;
locate [-chilSuUvV] pattern
  -c\tSuppress normal output; instead print a count of matching file n
+ames.
  -h\tPrint this screen.
  -i\tIgnore case distinctions in both the pattern and the database.
  -l number
  \tLimit output to number of file names and exit.
  -S\tShow date of last database update and number of files in databas
+e.
  -u\tUpdate file database. (This may take several minutes.)
  -U\tSame as -u, only with verbose output.
  -v\tVerbose output. Includes file size and time of last modification
+.
  -V\tPrint version information.
END
    exit;
}

sub Wanted {
    $file = $mtime = $kb = undef;

    if ( -d $name ) { next }
    
    #-----------------------------------------------------------------
+---#
    # I included the following two lines for use on my Win32
    # system. I didn't see a need to index temporary files. Leave
    # them commented or uncomment them as you see fit.
    #-----------------------------------------------------------------
+---#
    #if ( $name =~ /temporary internet/i ) { next }
    #if ( $name =~ /\.tmp/i ) { next }

    $count++;
        
    if ( $opt_U ) {
        $Count = Commas( $count );
        $mod = $count % 10;
        if ( $mod == 0 ) {
            $mess = "Files Processed: $Count";
            print "\r$mess" . ( " " x ( 75 - length $mess ) );
        }
    }

    $size = ( stat($name) )[7];
    $mod = localtime( ( stat($name) )[9] );

    if ( $size > 1024 ) {
        $size = sprintf( "%.2f", $size / 1024 ) . "KB";
    } else {
        $size .= " bytes";
    }

    if ( defined $Files{$name} ) {
        ( $mtime, $kb ) = split( /\|/,$Files{$name} );
    }

    if ( $mtime ne $mod ) {
    $Files{$name} = "$mod\|$size";
    } else {
        next;
    }
}

sub Commas {
    local $_ = shift;
    1 while s/^(-?\d+)(\d{3})/$1,$2/;
    return $_;
}

sub Show {
    if ( $opt_v ) {
    ( $mod, $size ) = split( /\|/,$Files{$file} );
        $date = UnixDate( $mod, "%e\-%b\-%Y %T" );
        print("$file ($size) $date\n");
    } else {
        print $file, "\n";
    }
}

sub OpenDB {
    dbmopen( %Files, "$databaseDir/$databaseName", 0666 );
}

sub CloseDB {
    dbmclose ( %Files );
}
Replies are listed 'Best First'.
Re: Perl port of locate
by Hofmator (Curate) on Jul 19, 2001 at 18:59 UTC

    Maybe you should get in contact with the guys from PPT, a quick check there showed that locate has not been implemented yet.

    -- Hofmator

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://98084]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2024-04-19 17:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found