1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
|
#! @im_path_perl@
################################################################
###
### imgrep :: Internet Message g/RE/p
###
### Copyright (C) 1997 Internet Message Group
###
### This Perl5 library conforms
### GNU GENERAL PUBLIC LICENSE Version 2.
###
###
### Author: Internet Message Group <img@mew.org>
### Created: Apr 23, 1997
### Revised: @im_revised@
###
my $VERSION = "imgrep @im_version@";
$Prog = 'imgrep';
##
## Require packages
##
use IM::Config;
use IM::Folder;
use IM::Grep;
use IM::Util;
use integer;
use strict;
use vars qw($Prog $EXPLANATION @OptConfig
$opt_format @opt_src $opt_casefold $opt_expression
$opt_delimiter $opt_verbose $opt_debug
$opt_quiet $opt_help);
##
## Environments
##
$opt_format = 'number'; # use number, folder, or path
$opt_casefold = 'yes'; # default case-insensitive
my @default_ranges = ();
my @opt_folders = ();
my $eval_string = ''; # store search engine
# regexp for range syntax (sequence not supported)
my $range_element = '(\\d+|cur|first|last|next|prev|new)';
my $range_regexp = "($range_element(-$range_element|:[+-]?\\d+)?|all)";
$EXPLANATION = "
$Prog :: Internet Message GREP
$VERSION
Usage :: $Prog [options] [+folder] [range]
";
@OptConfig = (
'src;F@;;' => 'msg source: "+folder:[range[,range..]]"',
'format;s;;' => 'Output format: "number", "folder", or "path"'.
"\n\t\t(default: \"number\" for single target folder".
"\n\t\t \"path\" for multiple target folders)",
'casefold;b;on;' => 'Case sensitivity'.
"\n\t\t(This option affects both fieldname and pattern.)",
'expression;s;;' => 'Search expression:'.
"\n\n\t\tUsable keyword".
"\n\t\t\t& && logical AND".
"\n\t\t\t| || logical OR".
"\n\t\t\t! logical NOT".
"\n\t\t\t( ) parens".
"\n\t\t\tfieldname=pattern search pattern for the field".
"\n\n\t\tSpecial fieldname:".
"\n\t\t\thead Entire header".
"\n\t\t\tbody Entire body".
"\n\t\t\tall Entire message",
'delimiter;s;\n\n|\n----\n;' => 'Mail header delimiter',
'quiet;b;;' => 'Suppress informational messages.',
'verbose;b;;' => 'With diagnostic messages.',
'debug;d;;' => 'With debug messages.',
'help;b;;' => 'Show this messages.',
);
##
## Profile and option processing
##
init_opt(\@OptConfig);
read_cfg();
read_opt(\@ARGV); # help?
help($EXPLANATION) && exit $EXIT_SUCCESS if $opt_help;
debug_option($opt_debug) if $opt_debug;
##
## Main
##
my $default_folder = cur_folder(); # must set here
#
# Fix some valuables
#
@opt_src = sortuniq(@opt_src);
@opt_src or @opt_src = ( $default_folder );
@default_ranges = ( @ARGV ? @ARGV : 'all' );
if ( $opt_format eq 'number' and @opt_src > 1 ) {
$opt_format = 'path';
}
#
# Compile expression
#
$eval_string = parse_expression($opt_expression, $opt_casefold);
#
# Iterate each folder
#
my $matched = 0;
FOLDER:
foreach (@opt_src) {
my ($folder, $ranges) = (/([^:]+)(?::)?(.*)?/);
my $folder_dir;
my @ranges = split(',', $ranges);
my @messages = ();
if ( $folder =~ /^\-/ ) {
im_warn("Newsspool $folder search not supported (ignored)\n");
next FOLDER;
}
@ranges = ( $ranges ? @ranges : @default_ranges );
$folder_dir = expand_path($folder);
@messages = grep_folder($folder_dir, $eval_string, @ranges);
if ( @messages ) {
$matched += @messages;
foreach ( @messages ) {
print "$folder:" if ($opt_format eq 'folder');
print "$folder_dir/" if ($opt_format eq 'path');
print "$_\n";
# flush('STDOUT');
}
}
}
$matched
or do {
if ($opt_quiet) {
exit $EXIT_ERROR;
} else {
im_die2("no message matches specifications\n");
}
};
exit $EXIT_SUCCESS;
##
## End of Main
##
##################################################
### Local Variables:
### mode: perl
### End:
|