[16886] in Perl-Users-Digest
Perl-Users Digest, Issue: 4298 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Sep 12 14:10:36 2000
Date: Tue, 12 Sep 2000 11:10:21 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <968782221-v9-i4298@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 12 Sep 2000 Volume: 9 Number: 4298
Today's topics:
Re: Is there a file rename function? (Tom Christiansen)
Memory problems - how to free up <akelingos@petrosys-usa.com>
Re: Memory problems - how to free up (Eric Bohlman)
Re: Memory problems - how to free up nobull@mail.com
Re: Memory problems - how to free up <akelingos@petrosys-usa.com>
Re: min function <jeffp@crusoe.net>
Re: min function <stephen.kloder@gtri.gatech.edu>
Re: min function mexicanmeatballs@my-deja.com
Re: min function <ren.maddox@tivoli.com>
Re: min function (brian d foy)
Re: min function (brian d foy)
Re: min function (brian d foy)
Re: open'ing lynx doesn't work when called by cron <iltzu@sci.invalid>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 12 Sep 2000 09:14:38 -0700
From: tchrist@perl.com (Tom Christiansen)
Subject: Re: Is there a file rename function?
Message-Id: <39be485e@cs.colorado.edu>
In article <MPG.142817528c751b8d989778@localhost>,
jason <elephant@squirrelgroup.com> wrote:
>or the existing tools on a system without 'grep'
There are none without grep, nay, not one, for behold here a Grep
for All Systems:
% perl -ne 'INIT{$p=shift} print if /$p/o' pattern file1 file2 ...
Voilą. C'est tout. There's nothing else to it. There's no
excuse for not being able to grep. None at all.
--tom
PS: Or, if you prefer something more feature-full...
#!/usr/local/bin/perl
package PPT::tcgrep;
use warnings;
use re 'eval';
###
### DON'T FORGET TO UPDATE THE POD IF YOU ADD TO THE HISTORY!!!
###
# tcgrep: tom christiansen's rewrite of grep
# v1.0: Thu Sep 30 16:24:43 MDT 1993
# v1.1: Fri Oct 1 08:33:43 MDT 1993
#
# Revision by Greg Bacon <gbacon@cs.uah.edu>
# Fixed up highlighting for those of us trapped in terminfo
# implemented -f
# v1.2: Fri Jul 26 13:37:02 CDT 1996
#
# Revision by Greg Bacon <gbacon@cs.uah.edu>
# Avoid super-inefficient matching (almost twice as fast! :-)
# v1.3: Sat Aug 30 14:21:47 CDT 1997
#
# Revision by Paul Grassie <grassie@worldnet.att.net>
# Removed vestiges of Perl4, made strict
# v1.4: Mon May 18 16:17:48 EDT 1998
#
# Revision by Greg Bacon <gbacon@cs.uah.edu>
# Add fgrep functionality for PPT
# v1.5: Mon Mar 8 12:05:29 CST 1999
#
# Revision by Bill Benedetto <bbenedetto@goodyear.com>
# Added CLOSE after each file is done to reset counters
# v1.6: Sat Mar 20 23:05:35 1999
#
# Revision by Tom Christiansen <tchrist@perl.com>
# Refined -w behavior slightly, added -DgLOoRSVW flags, and
# converted into a progmod, most of which is at least partially
# to help support the modularized perldoc rewrite
# v1.7: Wed Sep 6 06:18:38 MDT 2000
use strict;
# globals
our ($Me, $Errors, $Grand_Total, $Mult, %Compress, $Matches, $VERSION,
$VERSDATE);
if (!caller) {
exit(main(@ARGV));
}
require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/tcgrep/;
sub tcgrep {
return main(@_);
}
sub main {
local @ARGV = @_ if @_;
my ($matcher, $opt); # matcher - anon. sub to check for matches
# opt - ref to hash w/ command line options
init(); # initialize globals
# get command line options and patterns
return(3) unless ($opt, $matcher) = parse_args();
return(0) if $opt->{"V"};
matchfile($opt, $matcher, @ARGV); # process files
return(2) if $Errors;
return(0) if $Grand_Total;
return(1);
}
###################################
sub init {
$VERSION = 1.7;
$VERSDATE = "Wed Sep 6 06:18:38 MDT 2000";
($Me = $0) =~ s!.*/!!; # get basename of program, "tcgrep"
$Me = "tcgrep via $Me" unless $Me =~ /tcgrep/;
$Errors = $Grand_Total = 0; # initialize global counters
$Mult = ""; # flag for multiple files in @ARGV
$| = 1; # autoflush output
%Compress = ( # file extensions and program names
z => 'gzip -dc', # for uncompressing
gz => 'gzip -dc',
Z => 'zcat',
);
}
###################################
sub usage {
# this lies. -C is not a std opt!
die <<EOF
usage: $Me [flags] [files]
Standard grep options:
i case insensitive
n number lines
c give count of lines matching
C ditto, but >1 match per line possible
w word boundaries only (like w in vi)
s silent mode
x exact matches only
v invert search sense (lines that DON'T match)
h hide filename even if just one given
o output filenames even if only one given
e expression (for exprs beginning with -)
f file with expressions
l list filenames matching
F search for fixed strings (disable regular expressions)
Specials:
1 limit output to first match per file
W whitespace-delimited word boundaries (like W in vi)
H highlight matches
u underline matches
O use basename without extension for filename output
r recursive on directories, or dot if none
R recurse as -r, but only examine files matching pattern
t process directories in `ls -t` order
p paragraph mode (default: line mode)
P ditto, but specify separator, e.g. -P '%%\\n'
D draw a line of dashes between paragraph matches
g pod mode: ignore nonpod paragraphs
S show matching pod sections only
L space means whitespace, plus add /m and /s
a all files, not just plain text files
q quiet about failed file and dir opens
T trace files as opened
V print version number
May use a TCGREP environment variable to set default options.
EOF
}
###################################
sub parse_args {
use Getopt::Std;
my ($optstring, $zeros, $nulls, %opt, $pattern, @patterns, $match_code);
my ($SO, $SE);
if ($_ = $ENV{TCGREP}) { # get envariable TCGREP
s/^([^\-])/-$1/; # add leading - if missing
unshift(@ARGV, $_); # add TCGREP opt string to @ARGV
}
$optstring = "incCwsxvhe:f:l1HurtpP:aqTFogWOSVLDR:";
$zeros = 'inCwxvhelutOWg'; # options to init to 0 (prevent warnings)
$nulls = 'pPSDR'; # options to init to "" (prevent warnings)
@opt{ split //, $zeros } = ( 0 ) x length($zeros);
@opt{ split //, $nulls } = ( '' ) x length($nulls);
getopts($optstring, \%opt) or usage();
if ($opt{V}) {
print "$Me version $VERSION, last modified $VERSDATE\n";
return (\%opt, ''); # no matcher here
}
my $no_re = $opt{F} || ($Me =~ /\bfgrep\b/);
if (0 && $Me =~ /\bpodgrep\b/) {
$opt{O} = 1;
$opt{g} = 1;
$opt{S} = 1 unless $opt{p};
}
$opt{p} = 1 if $opt{S};
if ($opt{f}) { # -f patfile
open(PATFILE, $opt{f}) or die qq($Me: Can't open '$opt{f}': $!);
# make sure each pattern in file is valid
while ( defined($pattern = <PATFILE>) ) {
chomp $pattern;
unless ($no_re) {
eval { 'foo' =~ /$pattern/, 1 } or
die "$Me: $opt{f}:$.: bad pattern: $@";
}
push @patterns, $pattern;
}
close PATFILE;
}
else { # make sure pattern is valid
$pattern = $opt{e};
$pattern = shift(@ARGV) unless defined $pattern && length $pattern;
usage() unless defined $pattern && length $pattern;
unless ($no_re) {
eval { 'foo' =~ /$pattern/, 1 } or
die "$Me: bad pattern: $@";
}
@patterns = ($pattern);
}
if ($no_re) {
for (@patterns) {
# XXX: quotemeta?
s/(\W)/\\$1/g;
}
}
# mumble mumble DeMorgan mumble mumble
if ($opt{v}) {
@patterns = join '|', map "(?:$_)", @patterns;
}
if ($opt{H} || $opt{u}) { # highlight or underline
my $term = $ENV{TERM} || 'vt100';
my $terminal;
eval { # try to look up escapes for stand-out
require POSIX; # or underline via Term::Cap
use Term::Cap;
my $termios = POSIX::Termios->new();
$termios->getattr;
my $ospeed = $termios->getospeed;
$terminal = Tgetent Term::Cap { TERM=>undef, OSPEED=>$ospeed }
};
unless ($@) { # if successful, get escapes for either
local $^W = 0; # stand-out (-H) or underlined (-u)
($SO, $SE) = $opt{H}
? ($terminal->Tputs('so'), $terminal->Tputs('se'))
: ($terminal->Tputs('us'), $terminal->Tputs('ue'));
}
else { # if use of Term::Cap fails,
($SO, $SE) = $opt{H} # use tput command to get escapes
? (`tput -T $term smso`, `tput -T $term rmso`)
: (`tput -T $term smul`, `tput -T $term rmul`)
}
}
if ($opt{w} && $opt{W}) {
usage("-w and -W flags mutually exclusive");
}
if ($opt{o} && $opt{h}) {
usage("-o and -h flags mutually exclusive");
}
$opt{o} && ($Mult = 1); # always output filenames
$opt{p} && ($/ = '');
$opt{P} && ($/ = eval(qq("$opt{P}"))); # for -P '%%\n'
# these two must precede the other mungeings
$opt{w} && (@patterns = map { emboundary($_)} @patterns);
$opt{W} && (@patterns = map { emBoundary($_)} @patterns);
if ($opt{L}) {
for (@patterns) {
s/ +/\\s+/g;
s/^/(?ms)/;
}
}
if ($opt{i}) {
@patterns = map {"(?i)$_"} @patterns;
}
if (!$opt{S} && ($opt{p} || $opt{P})) {
@patterns = map {"(?m)$_"} @patterns;
}
$opt{'x'} && (@patterns = map {"^$_\$"} @patterns);
$opt{S} && (@patterns = map {"(?=^=(?-i:item|head\\d)\\s+).*$_"} @patterns);
if (@ARGV) {
$Mult = 1 if ($opt{r} || (@ARGV > 1) || -d $ARGV[0]) && !$opt{h};
}
$opt{1} += $opt{l}; # that's a one and an ell
$opt{H} += $opt{u};
$opt{c} += $opt{C};
$opt{'s'} += $opt{c};
$opt{1} += $opt{'s'} && !$opt{c}; # that's a one
@ARGV = ($opt{r} ? '.' : '-') unless @ARGV;
$opt{r} = 1 if !$opt{r} && grep(-d, @ARGV) == @ARGV;
$match_code = '';
$match_code .= 'study;' if @patterns > 5; # might speed things up a bit
foreach (@patterns) { s(/)(\\/)g } # due to interpolation; need qx//
if ($opt{H}) {
foreach $pattern (@patterns) {
$match_code .= "\$Matches += s/($pattern)/${SO}\$1${SE}/g;";
}
}
elsif ($opt{v}) {
foreach $pattern (@patterns) {
$match_code .= "\$Matches += !/$pattern/;";
}
}
elsif ($opt{C}) {
foreach $pattern (@patterns) {
$match_code .= "\$Matches++ while /$pattern/g;";
}
}
else {
foreach $pattern (@patterns) {
$match_code .= "\$Matches++ if /$pattern/;";
}
}
print STDERR "$Me: [DEBUG] match code is $match_code\n" if $opt{T};
my $matcher = eval "sub { $match_code }";
die if $@;
return (\%opt, $matcher);
}
###################################
sub matchfile {
# XXX: why globals!? fixed, maybe
my $opt = shift; # reference to option hash
my $matcher = shift; # reference to matching sub
my ($file, @list, $total, $name);
local($_);
$total = 0;
FILE: while (defined ($file = shift(@_))) {
if (-d $file) {
if (-l $file && @ARGV != 1) {
warn "$Me: \"$file\" is a symlink to a directory\n"
if $opt->{T};
next FILE;
}
if (!$opt->{r}) {
warn "$Me: \"$file\" is a directory, but no -r given\n"
if $opt->{T};
next FILE;
}
unless (opendir(DIR, $file)) {
unless ($opt->{'q'}) {
warn "$Me: can't opendir $file: $!\n";
$Errors++;
}
next FILE;
}
@list = ();
for (readdir(DIR)) {
push(@list, "$file/$_") unless /^\.{1,2}$/;
}
closedir(DIR);
if ($opt->{t}) {
my (@dates);
for (@list) { push(@dates, -M) }
@list = @list[sort { $dates[$a] <=> $dates[$b] } 0..$#dates];
}
else {
@list = sort @list;
}
matchfile($opt, $matcher, @list); # process files
next FILE;
}
if ($file eq '-') {
warn "$Me: reading from stdin\n" if -t STDIN && !$opt->{'q'};
$name = '<STDIN>';
}
else { # next if $file =~ /\|$/ || ref(\$file) eq "GLOB";
if ($opt->{O}) {
# wish I could turn Foo/Bar.pm into Foo::Bar, but who
# knows whether Foo is part of it?
require File::Basename;
($name) = File::Basename::fileparse($file, qr/\..*/);
} else {
$name = $file;
}
unless (-e $file) {
warn qq($Me: file "$file" does not exist\n) unless $opt->{'q'};
$Errors++;
next FILE;
}
unless (-f $file || $opt->{a}) {
warn qq($Me: skipping non-plain file "$file"\n) if $opt->{T};
next FILE;
}
if ($opt->{R} && $file !~ /$$opt{R}/o) {
warn qq($Me: -R$opt->{R} filtered out "$file"\n) if $opt->{T};
next;
}
my ($ext) = $file =~ /\.([^.]+)$/;
# XXX: stacked extensions/filters not supported
if (defined $ext && exists $Compress{$ext}) {
$file = "$Compress{$ext} <$file |";
}
elsif ($opt->{g} && ($ext || '') ne 'pod') {
# needs catpod filter installed
$file = "catpod $file |";
}
elsif (! (-T $file || $opt->{a})) {
warn qq($Me: skipping binary file "$file"\n) if $opt->{T};
next FILE;
}
}
warn "$Me: checking $file\n" if $opt->{T};
if (ref(\$file) eq "GLOB") {
*FILE = $file;
} else {
unless (open(FILE, $file)) {
unless ($opt->{'q'}) {
warn "$Me: $file: $!\n";
$Errors++;
}
next FILE;
}
}
$total = 0;
$Matches = 0;
# next are for pod section mode only
my $in_region = 0;
my $directive;
my $just_itemmed = 0;
my $printed = 0;
my $paragraphing = $opt->{S} || $opt->{P} || $opt->{p};
LINE: while (<FILE>) {
$Matches = 0;
##############
&{$matcher}(); # do it! (check for matches)
##############
if ($opt->{S}) { # pod section mode
if ($in_region) {
if (!$Matches && /^=(head\d|item|back)/) {
unless ( ($just_itemmed && $1 eq 'item')
|| subordinate_directive($1, $directive) )
{
$just_itemmed = $in_region = 0;
$printed = 0;
next LINE;
}
}
# fall through to the print, since we're in the section
} elsif ($Matches) {
($directive) = /^=(head\d|item)/;
$in_region = 1;
$just_itemmed = ($directive || '') eq 'item';
} else {
# not already in section, nor new match, so bye
$just_itemmed = 0;
$printed = 0;
next LINE;
}
$just_itemmed = /^=item/;
print $opt->{n}
? "\n\n=head1 $name\n\n"
: "\n\n=head1 $name chunk $.\n\n"
if ($opt->{n} || $Mult) && !$printed++ && !$opt->{'s'} && !$opt->{'h'};
print;
$total += $Matches;
next LINE;
} else {
next LINE unless $Matches;
}
$total += $Matches;
if ($opt->{D} && ($opt->{p} || $opt->{P})) {
s/\n{2,}$/\n/ if $opt->{p} && !$opt->{S};
chomp if $opt->{P};
}
print("$name\n"), next FILE if $opt->{l};
unless ($opt->{'s'}) { # for silent
print $Mult && "$name:",
$opt->{n} ? "$.:" : "",
($paragraphing && /^\s/ && "\n"),
$_,
($opt->{D} && ($opt->{p} || $opt->{P})) && ('-' x 20) . "\n",
}
next FILE if $opt->{1}; # that's a one
}
}
continue {
print $Mult && "$name:", $total, "\n" if $opt->{c};
close FILE;
}
$Grand_Total += $total;
}
sub emboundary {
local $_ = $_[0];
s/^(?=\w)/\\b/
||
s/^/(?:^|(?<=\\s))/;
s/(?<=\w)$/\\b/
||
s/$/(?:$|(?=\\s))/;
return $_;
}
sub emBoundary {
local $_ = $_[0];
s/^/(?:^|(?<=\\s))/;
s/$/(?:\\Z|(?=\\s))/;
return $_;
}
# is the new directive subordinate to the old one?
sub subordinate_directive {
my($new, $old) = @_;
return 1 unless $new =~ /^(back|item|head\d)$/;
return 0 if $old eq 'item' && $new eq 'back';
return 0 if $old eq 'back';
return 1 if $new eq 'back';
return 0 if $new eq $old;
return 1 if $new eq 'item'; # old must be head
return 0 if $old eq 'item'; # new must be head
# both must be heads; compare numbers
return substr($new, -1) > substr($old, -1);
}
1;
__END__
=pod
=head1 NAME
B<tcgrep> - search for regular expressions and print
=head1 SYNOPSIS
B<tcgrep> [ B<-[incCwsxvhlF1HurtpaqT]> ] [ B<-e> I<pattern> ]
[ B<-f> I<pattern-file> ] [ B<-P> I<sep> ] [ I<pattern> ] [ I<files> ... ]
=head1 DESCRIPTION
B<tcgrep> searches for lines (or, optionally, paragraphs) in files
that satisfy the criteria specified by the user-supplied patterns.
Because B<tcgrep> is a Perl program, the user has full access to
Perl's rich regular expression engine. See L<perlre>.
The first argument after the options (assuming the user did not specify
the B<-e> option or the B<-f> option) is taken as I<pattern>.
If the user does not supply a list of file or directory names to
search, B<tcgrep> will attempt to search its standard input.
With no arguments, B<tcgrep> will output its option list and exit.
=head1 OPTIONS
B<tcgrep> accepts these options:
=over 4
=item B<-1>
Allow at most one match per file.
=item B<-a>
Search all files. The default is to only search plain text files
and compressed files.
=item B<-c>
Output the count of the matching lines or paragraphs.
=item B<-C>
Output the count of the matching lines or paragraphs. This is similar
to the B<-c> option (in fact, it implies the B<-c> option), except more
than one match is possible in each line or paragraph.
=item B<-D>
Output a big row of dashes between paragraph matches.
This used to be the default on B<-p> or B<-P>.
=item B<-e> I<pattern>
Treat I<pattern> as a pattern. This option is most useful when
I<pattern> starts with a C<-> and the user wants to avoid confusing
the option parser.
The B<-f> option supersedes the B<-e> option.
=item B<-f> I<pattern-file>
Treat I<pattern-file> as a newline-separated list of patterns to use
as search criteria.
=item B<-F>
B<fgrep> mode. Disable regular expressions and perform Boyer-Moore
searches. (Whether it lives up to the 'f' in B<fgrep> is another
issue). This mode is also enabled if the program's name contains
the pattern C<fgrep>, so a link by that name will work.
=item B<-g>
Filter any files that do not end in F<.pod> I<catpod>(1) before
processing.
=item B<-H>
Highlight matches. This option causes B<tcgrep> to attempt to use
your terminal's stand-out (emboldening) functionality to highlight
those portions of each matching line or paragraph that actually
triggered the match. This feature is very similar to the way the
less(1) pager highlights matches. See also B<-u>.
=item B<-h>
Hide filenames. Normally when multiple files are searched, the
filename is printed in front of each matching record (line or paragraph),
but is omitted when only one file is consulted. See also the B<-o> and
B<-O> flags.
=item B<-i>
Ignore case while matching. This means, for example, that the pattern
C<unix> would match C<unix> as well as C<UniX> (plus the other fourteen
possible capitalizations). This corresponds to the C</i> Perl regular
expression switch. See L<perlre>.
=item B<-L>
Extended line mode, used when matching "lines" that extend past
newline boundaries. Any stetches of whitespace in the pattern are
implicitly converted into C<\s+>, and the C</m> and C</s> pattern
matching flags are enabled.
=item B<-l>
List files containing matches. This option tells B<tcgrep> not to
print any matches but only the names of the files containing matches.
This option implies the B<-1> option.
=item B<-n>
Number lines or paragraphs. Before outputting a given match, B<tcgrep>
will first output its line or paragraph number corresponding to the
value of the Perl magic scalar $. (whose documentation is in L<perlvar>).
=item B<-o>
Always output the filename in front of each matching record, even when
only one file matches. See also the B<-h> flag.
=item B<-O>
Like B<-o>, but output just the file's basename, without its directory
or extension if any.
=item B<-p>
Paragraph mode. This causes B<tcgrep> to set Perl's magic $/ to C<''>.
(Note that the default is to process files in line mode.) See L<perlvar>.
=item B<-P> I<sep>
Put B<tcgrep> in paragraph mode, and use I<sep> as the paragraph
separator. This is implemented by assigning I<sep> to Perl's magic
$/ scalar. See L<perlvar>.
=item B<-q>
Quiet mode. Suppress diagnostic messages to the standard error. See
B<-s>.
=item B<-R>I<pattern>
Recursively scan directories as with the B<-r> flag, but only files
whose names match the I<pattern> are consulted.
=item B<-r>
Recursively scan directories. This option causes B<tcgrep> to
descend directories in a left-first, depth-first manner and search
for matches in the files of each directory it encounters. The
presence of B<-r> implies a file argument of F<.>, the current
directory, if the user does not provide filenames on the command line.
See L<"EXAMPLES">.
=item B<-s>
Silent mode. Do not write to the standard output. This option would
be useful from a shell script, for example, if you are only interested
in whether or not there exists a match for a pattern. See also B<-q>.
=item B<-S>
Pod section search mode. Only pod headers are searched, but if a
match is found, all that section's contents down to the next section
of the same or higher level are printed.
=item B<-T>
Trace files as processed. This causes B<tcgrep> to send diagnostic
messages to the standard error when skipping symbolic links to directories,
when skipping directories because the user did not give the B<-r> switch,
when skipping non-plain files (see L<perlfunc/-f>),
when skipping non-text files (see L<perlfunc/-T>), and
when opening a file for searching
=item B<-t>
Process directories in C<`ls -t`> order. Search the files in each
directory starting with the most recently modified and ending with
the least recently modified.
=item B<-u>
Underline matches. This option causes B<tcgrep> to attempt to use
your terminal's underline functionality to underline those portions of
each matching line or paragraph that actually triggered the match.
See also B<-H>.
=item B<-v>
Invert the sense of the match, i.e. print those lines or paragraphs
that do B<not> match. When using this option in conjunction with B<-f>,
keep in mind that the entire set of patterns are grouped together in
one pattern for the purposes of negation. See L<"EXAMPLES">.
=item B<-V>
Emit version number and exit.
=item B<-w>
Matches must start and end at word boundaries. Alphanumunders (that
is, C<\w> characters) must have either the edge of the string or
else a non-alphanumber (that is, C<\W>) character next to them
(before at the beginning; after at the end). Non-alphanumbers at
the edges must have either whitespace or the string edge next to
them. Corresponds loosely to the C<w> motion command in vi(1).
See L<perlre> for the precise definition of C<\b>.
=item B<-W>
Like B<-w>, but these "words" must always be surrounded by either
whitespace or the edge of the string. Corresponds loosely to the
C<W> motion command in vi(1).
=item B<-x>
Exact matches only. The pattern must match the entire line or paragraph.
=back
=head1 ENVIRONMENT
The user's TCGREP environment variable is taken as the default set of
options to B<tcgrep>.
=head1 EXAMPLES
Recursively search all files under F</etc/init.d> for a particular pattern:
% tcgrep -r tcgrep /etc/init.d
Recursively search all files that end in F<.pod> or C<.pm>
under F</usr/local/perl/lib> for any BUGS sections in their pods,
filtering the F<.pm> files through catpod(1) first:
% tcgrep -R '\.p(od|m)$' -gS BUGS /usr/local/perl/lib
Use of B<-v> and B<-f> options in conjunction with one another:
% cat fruits
pomme
banane
poire
% cat pats
pomme
poire
% tcgrep -vf pats fruits
banane
=head1 MODULE USE
This program doubles as a module, which can be "sourced" in for
repeated use by an existing program without resorting to exec.
The programs normal exit status is returned.
For example:
use PPT::tcgrep; # imports
$status = tcgrep("-p", "pattern", glob("*.c"));
Standard input and standard output are treated just as the program
would treat them, so if you intend to capture its output, you should
change the default print handle, or redirect standard output.
=head1 SEE ALSO
perlre(1), catpod(1), perlpod(1), podgrep(1), grep(1),
=head1 TODO
Add more cool examples. :-)
=head1 REVISION HISTORY
tcgrep: tom christiansen's rewrite of grep
v1.0: Thu Sep 30 16:24:43 MDT 1993
v1.1: Fri Oct 1 08:33:43 MDT 1993
Revision by Greg Bacon <gbacon@cs.uah.edu>
Fixed up highlighting for those of us trapped in terminfo
implemented -f
v1.2: Fri Jul 26 13:37:02 CDT 1996
Revision by Greg Bacon <gbacon@cs.uah.edu>
Avoid super-inefficient matching (almost twice as fast! :-)
v1.3: Sat Aug 30 14:21:47 CDT 1997
Revision by Paul Grassie <grassie@worldnet.att.net>
Removed vestiges of Perl4, made strict
v1.4: Mon May 18 16:17:48 EDT 1998
Revision by Greg Bacon <gbacon@cs.uah.edu>
Add fgrep functionality for PPT
v1.5: Mon Mar 8 12:05:29 CST 1999
Revision by Bill Benedetto <bbenedetto@goodyear.com>
Added CLOSE after each file is done to reset counters
v1.6: Sat Mar 20 23:05:35 1999
Revision by Tom Christiansen <tchrist@perl.com>
Refined -w behavior slightly, added -DgLOoRSVW flags, and
converted into a progmod, most of which is at least partially
to help support the modularized perldoc rewrite
v1.7: Wed Sep 6 06:18:38 MDT 2000
=head1 AUTHOR
B<tcgrep> was written by Tom Christiansen with updates by Greg Bacon
and Paul Grassie.
=head1 COPYRIGHT and LICENSE
Copyright (c) 1993-2000. Tom Christiansen.
This program is free and open software. You may use, copy, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.
=cut
------------------------------
Date: Tue, 12 Sep 2000 11:42:55 -0500
From: "Alec Kelingos" <akelingos@petrosys-usa.com>
Subject: Memory problems - how to free up
Message-Id: <srsn1sn8ct613@corp.supernews.com>
I'm trying to destroy large arrays and hashes in a perl routine to free up
memory. On Unix I'm looking at memory with vmstat 3 (display system info
every 3 seconds). Here's a test script:
# Populate a big array
my $i = 0;
while ( $i < 1000000 ) {
$tmp[$i] = 'abcdefg';
$i++;
}
my $size = @tmp;
print "array populated with $size elements - press enter";
my $resp = <STDIN>;
# Try to destroy the @tmp array and free up memory
while (@tmp) {pop @tmp;}
$size = @tmp;
print "array deleted now has $size elements - press enter";
$rest = <STDIN>;
While the array is populating I can clearly see the amount of free memory
going down. After all elements have been poped the array size is 0 BUT
vmstat reports that the same amount of memory is being used. When the perl
routine exits, vmstat shows the memory shoot back up.
I've tried using delete on hash elements too and have the same problem.
HOW CAN I DESTROY arrays/hashes and free up memory? All my Perl books says
that Perl does this automatically - what am I missing?
Thanks in advance
Alec
------------------------------
Date: 12 Sep 2000 17:05:44 GMT
From: ebohlman@netcom.com (Eric Bohlman)
Subject: Re: Memory problems - how to free up
Message-Id: <8plnp8$get$1@slb3.atl.mindspring.net>
Alec Kelingos (akelingos@petrosys-usa.com) wrote:
: I'm trying to destroy large arrays and hashes in a perl routine to free up
: memory. On Unix I'm looking at memory with vmstat 3 (display system info
: every 3 seconds). Here's a test script:
[snip]
: While the array is populating I can clearly see the amount of free memory
: going down. After all elements have been poped the array size is 0 BUT
: vmstat reports that the same amount of memory is being used. When the perl
: routine exits, vmstat shows the memory shoot back up.
:
: I've tried using delete on hash elements too and have the same problem.
:
: HOW CAN I DESTROY arrays/hashes and free up memory? All my Perl books says
: that Perl does this automatically - what am I missing?
perl won't return freed memory to the OS until it exits. The freed
memory becomes available to perl itself (i.e. if you create another hash
or array, it will use the freed-up memory rather than asking the OS to
give it more memory).
------------------------------
Date: 12 Sep 2000 18:22:01 +0100
From: nobull@mail.com
Subject: Re: Memory problems - how to free up
Message-Id: <u9r96p34qu.fsf@wcl-l.bham.ac.uk>
"Alec Kelingos" <akelingos@petrosys-usa.com> writes:
> HOW CAN I DESTROY arrays/hashes and free up memory?
This questions appears in the FAQ as "How can I free an array or hash
so my program shrinks?"
Please read the FAQ _before_ you post.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Tue, 12 Sep 2000 12:56:34 -0500
From: "Alec Kelingos" <akelingos@petrosys-usa.com>
Subject: Re: Memory problems - how to free up
Message-Id: <srsrbvelct6162@corp.supernews.com>
Thanks for the tip.
Eric Bohlman <ebohlman@netcom.com> wrote in message
news:8plnp8$get$1@slb3.atl.mindspring.net...
> Alec Kelingos (akelingos@petrosys-usa.com) wrote:
> : I'm trying to destroy large arrays and hashes in a perl routine to free
up
> : memory. On Unix I'm looking at memory with vmstat 3 (display system
info
> : every 3 seconds). Here's a test script:
>
> [snip]
>
> : While the array is populating I can clearly see the amount of free
memory
> : going down. After all elements have been poped the array size is 0 BUT
> : vmstat reports that the same amount of memory is being used. When the
perl
> : routine exits, vmstat shows the memory shoot back up.
> :
> : I've tried using delete on hash elements too and have the same problem.
> :
> : HOW CAN I DESTROY arrays/hashes and free up memory? All my Perl books
says
> : that Perl does this automatically - what am I missing?
>
> perl won't return freed memory to the OS until it exits. The freed
> memory becomes available to perl itself (i.e. if you create another hash
> or array, it will use the freed-up memory rather than asking the OS to
> give it more memory).
>
------------------------------
Date: Tue, 12 Sep 2000 11:25:44 -0400
From: Jeff Pinyan <jeffp@crusoe.net>
Subject: Re: min function
Message-Id: <Pine.GSO.4.21.0009121101100.12441-100000@crusoe.crusoe.net>
On Sep 12, Randal L. Schwartz said:
>>>>>> "Jeff" == Jeff Pinyan <jeffp@crusoe.net> writes:
>
>Jeff> on your own. If I gave you a list of numbers,
>
>Jeff> 4 0 21 3 -2 18
>
>Jeff> how would YOU determine the smallest? Write your function in the same
>Jeff> manner.
>
> (Fires up Squeak)
> (open workspace)
> {4. 0. 21. 3. -2. 18} min
> (press command-P for "print it")
You poor, poor soul. I'd have done
def min (seq):
"""returns minimum of a list of numbers"""
if type(seq) != type(()): seq = tuple(seq)
if seq == (): return None
return reduce(lambda A,B: (A,B)[A>B], seq[1:], seq[0])
I think I'll run for cover.
--
Jeff "japhy" Pinyan japhy@pobox.com http://www.pobox.com/~japhy/
PerlMonth - An Online Perl Magazine http://www.perlmonth.com/
The Perl Archive - Articles, Forums, etc. http://www.perlarchive.com/
CPAN - #1 Perl Resource (my id: PINYAN) http://search.cpan.org/
------------------------------
Date: Tue, 12 Sep 2000 11:42:07 -0400
From: Stephen Kloder <stephen.kloder@gtri.gatech.edu>
Subject: Re: min function
Message-Id: <39BE4ECE.24477AD5@gtri.gatech.edu>
Jeff Pinyan wrote:
>
> You poor, poor soul. I'd have done
>
> def min (seq):
> """returns minimum of a list of numbers"""
> if type(seq) != type(()): seq = tuple(seq)
> if seq == (): return None
> return reduce(lambda A,B: (A,B)[A>B], seq[1:], seq[0])
>
> I think I'll run for cover.
>
You'd better. You could have just done:
>>> min(4,0,21,3,-2,18)
-2
or:
>>> min([4,0,21,3,-2,18])
-2
(depending on how you get your numbers)
------------------------------
Date: Tue, 12 Sep 2000 15:54:51 GMT
From: mexicanmeatballs@my-deja.com
Subject: Re: min function
Message-Id: <8pljjt$nrv$1@nnrp1.deja.com>
In article <Pine.GSO.4.21.0009121101100.12441-100000@crusoe.crusoe.net>,
japhy@pobox.com wrote:
> On Sep 12, Randal L. Schwartz said:
>
> >>>>>> "Jeff" == Jeff Pinyan <jeffp@crusoe.net> writes:
> >
> >Jeff> on your own. If I gave you a list of numbers,
> >
> >Jeff> 4 0 21 3 -2 18
> >
> >Jeff> how would YOU determine the smallest? Write your function in
the same
> >Jeff> manner.
> >
> > (Fires up Squeak)
> > (open workspace)
> > {4. 0. 21. 3. -2. 18} min
> > (press command-P for "print it")
>
> You poor, poor soul. I'd have done
>
> def min (seq):
> """returns minimum of a list of numbers"""
> if type(seq) != type(()): seq = tuple(seq)
> if seq == (): return None
> return reduce(lambda A,B: (A,B)[A>B], seq[1:], seq[0])
>
> I think I'll run for cover.
>
I don't have Squeak, whatever it is...
#!/usr/bin/perl -w
use strict;
open SOURCE, ">min.c";
print SOURCE <<'CODE';
#include <stdio.h>
#include <stdlib.h>
int main(int argc, char *argv[]) {
long num, min;
scanf("%d", &min);
while(!feof(stdin)) {
scanf("%d", &num);
if(num<min) {
min=num;
}
}
printf("%d", min);
}
CODE
print `gcc min.c -o min`;
open MIN, "|./min";
print MIN "4 0 21 3 -2 18";
close MIN;
Sometimes I think my Perl looks too much like C...
--
Jon
perl -e 'print map {chr(ord($_)-3)} split //, "MrqEdunhuClqdph1frp";'
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: 12 Sep 2000 10:59:05 -0500
From: Ren Maddox <ren.maddox@tivoli.com>
Subject: Re: min function
Message-Id: <m3d7i91u0m.fsf@dhcp11-177.support.tivoli.com>
tchrist@perl.com (Tom Christiansen) writes:
> In article <39BE321E.5324273C@cat.com>,
> Shawn Ribordy <Ribordy_Shawn_C@cat.com> wrote:
> >Of course I could write one! - but why reinvent the wheel right!
>
> Reinvent what wheel? If this requires invention, you're working
> far, far too hard. That's like asking whether someone knows how
> to determine whether a number is odd, and not liking that there's
> no plug-and-pray module to throw at it. Trivial problems should
> not require canned, opaque solutions.
Just because something is simple, doesn't mean you shouldn't expect a
canned solution to exist. I don't think the OP is looking for a
module, just expecting to find a built-in function and being slightly
surprised not to find one.
The simplicity with which push, pop, shift and unshift can be
implemented (using splice or otherwise) does not preclude them from
being built-in functions. And unless I'm missing something, all four
of those are actually easier to implement than min (and max).
--
Ren Maddox
ren@tivoli.com
------------------------------
Date: Tue, 12 Sep 2000 13:36:46 -0400
From: brian@smithrenaud.com (brian d foy)
Subject: Re: min function
Message-Id: <brian-ya02408000R1209001336460001@news.panix.com>
In article <Pine.GSO.4.21.0009121101100.12441-100000@crusoe.crusoe.net>, japhy@pobox.com posted:
> def min (seq):
> """returns minimum of a list of numbers"""
> if type(seq) != type(()): seq = tuple(seq)
> if seq == (): return None
> return reduce(lambda A,B: (A,B)[A>B], seq[1:], seq[0])
what is all of that for?
L = [ 1, 4, 7, -2, 44, 0 ]
print min(L)
min() is a built-in function. throw in some stuff to catch a
TypeError exception if you want to get fancy.
--
brian d foy
CGI Meta FAQ <URL:http://www.smithrenaud.com/public/CGI_MetaFAQ.html>
Perl Mongers <URL:http://www.perl.org/>
------------------------------
Date: Tue, 12 Sep 2000 13:38:39 -0400
From: brian@smithrenaud.com (brian d foy)
Subject: Re: min function
Message-Id: <brian-ya02408000R1209001338390001@news.panix.com>
In article <8pljjt$nrv$1@nnrp1.deja.com>, mexicanmeatballs@my-deja.com posted:
> I don't have Squeak, whatever it is...
>
> #!/usr/bin/perl -w
> use strict;
> open SOURCE, ">min.c";
> print `gcc min.c -o min`;
> open MIN, "|./min";
> print MIN "4 0 21 3 -2 18";
> close MIN;
>
> Sometimes I think my Perl looks too much like C...
you could have used the Inline module and saved the extra process.
--
brian d foy
CGI Meta FAQ <URL:http://www.smithrenaud.com/public/CGI_MetaFAQ.html>
Perl Mongers <URL:http://www.perl.org/>
------------------------------
Date: Tue, 12 Sep 2000 13:39:35 -0400
From: brian@smithrenaud.com (brian d foy)
Subject: Re: min function
Message-Id: <brian-ya02408000R1209001339350001@news.panix.com>
In article <39BE2535.5BF72AF3@cat.com>, Shawn Ribordy <Ribordy_Shawn_C@cat.com> posted:
> I have looked all over the place, and I cannot find a min function. Can
> anyone help?
List::Util on CPAN has several iterator functions that are very
speedy.
--
brian d foy
CGI Meta FAQ <URL:http://www.smithrenaud.com/public/CGI_MetaFAQ.html>
Perl Mongers <URL:http://www.perl.org/>
------------------------------
Date: 12 Sep 2000 17:19:32 GMT
From: Ilmari Karonen <iltzu@sci.invalid>
Subject: Re: open'ing lynx doesn't work when called by cron
Message-Id: <968778248.24077@itz.pp.sci.fi>
In article <8par5h$lri$1@nnrp1.deja.com>, Richard Lawrence wrote:
>Apparantly the solution (according to the lynx bugs mailing list) is to
>place
>
> TERM=dumb
>
>before the lynx call (and not to use -term=DUMB as that doesn't work),
>which is great for shell scripts but I've no idea how to do that via
>perl.
This is how to do what you ask for. Note that what you really want is
probably LWP <http://search.cpan.org/search?dist=libwww-perl>.
{ local $ENV{TERM} = "dumb";
open RESULT, "lynx -dump http://www.site.com |" or die $!;
}
The braces are there to limit the scope of the localized change. I
also took the liberty of cleaning up your open() - the quotes around
the URL seemed completely useless to me.
--
Ilmari Karonen - http://www.sci.fi/~iltzu/
Please ignore Godzilla | "By promoting postconditions to
and its pseudonyms - | preconditions, algorithms become
do not feed the troll. | remarkably simple." -- Abigail
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V9 Issue 4298
**************************************
