#!/usr/bin/perl -w
# $Id: sagasu-helper.pl,v 1.4 2004/06/12 01:32:10 sarrazip Exp $
# sagasu-helper.pl - Search script for Sagasu - Assumes Latin-1 files
#
# sagasu - GNOME tool to find strings in a set of files
# Copyright (C) 2002-2004 Pierre Sarrazin
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
use strict;
use DirHandle;
use FileHandle;
use locale;
use POSIX qw(locale_h);
# This call allows case insensitive matching ($_ =~ /foo/i) that works
# with Latin-1 accented characters.
#
setlocale(LC_CTYPE, "fr_CA.ISO8859-1");
$| = 1; # no buffering for STDOUT
my $errPrefix = "*** "; # string that distinguishes error messages from rest
if (@ARGV != 7 || @ARGV >= 1 && $ARGV[0] eq "--help")
{
print < 20;
if (0) # debugging stuff
{
print "\@ARGV: '", join("|", @ARGV), "'\n";
print "Searching for: '$targetExpr'\n",
"Search directory: '$searchDir'\n",
"Patterns of files to search: '",
join(",", @filePatterns), "'\n",
"Recursion depth: $maxDepth\n";
}
$searchDir = prepareSearchDirName($searchDir);
searchDirTree($targetExpr, $searchDir, \@filePatterns, $caseSensitive, 0);
exit 0;
sub searchDirTree
{
my ($targetExpr, $searchDir, $raFilePatterns, $caseSensitive, $depth) = @_;
my $dh = new DirHandle($searchDir);
if (!defined $dh)
{
print "$errPrefix$searchDir: $!\n";
return;
}
my @filenameList = sort $dh->read();
my @dirList = ();
# First, search the regular files.
foreach my $filename (@filenameList)
{
next if $filename eq "." || $filename eq "..";
my $fullname = ($searchDir eq "/" ? "" : "$searchDir") . "/$filename";
stat($fullname);
if (-d _)
{
push @dirList, $filename unless
$filename eq "." || $filename eq "..";
}
elsif (-f _ && fileInPatterns($filename, $raFilePatterns))
{
searchFile($targetExpr, $fullname, $caseSensitive);
}
}
# Next, search the subdirectories.
foreach my $filename (@dirList)
{
my $fullname = ($searchDir eq "/" ? "" : "$searchDir") . "/$filename";
if ($depth < $maxDepth && (!$excludeSymlinkDirs || ! -l $fullname))
{
if (!$excludeCVSDirs || $filename ne "CVS")
{
searchDirTree($targetExpr,
$fullname, $raFilePatterns, $caseSensitive,
$depth + 1);
}
}
}
}
sub searchFile
{
my ($targetExpr, $searchFilename, $caseSensitive) = @_;
my $fh = new FileHandle;
return if !$fh->open($searchFilename);
my $line;
if ($caseSensitive)
{
while (defined($line = <$fh>))
{
chomp $line;
if ($line =~ /$targetExpr/)
{
print "$searchFilename:$.: $line\n";
}
}
}
else
{
while (defined($line = <$fh>))
{
chomp $line;
if ($line =~ /$targetExpr/i)
{
print "$searchFilename:$.: $line\n";
}
}
}
$fh->close();
}
sub fileInPatterns
{
my ($filename, $raFilePatterns) = @_;
my $ext;
foreach $ext (@$raFilePatterns)
{
return 1 if $filename =~ /^$ext$/;
}
return 0;
}
sub prepareSearchDirName
{
my ($searchDir) = @_;
if ($searchDir =~ /^~([^\/]*)$/ || $searchDir =~ /^~(.*?)\//)
{
my $username = $1;
if ($username eq "")
{
my $homedir = $ENV{"HOME"};
$searchDir =~ s/^~/$homedir/ if (defined $homedir);
}
else
{
my @userinfo = getpwnam($username);
if (@userinfo >= 8)
{
my $homedir = $userinfo[7];
$searchDir =~ s/^~$username/$homedir/;
}
}
}
return $searchDir;
}