#! parrot
=head1 NAME
pgegrep - A simple grep using PGE for matching
=head1 SYNOPSIS
B<pgegrep> [I<OPTIONS>] B<PATTERN> [I<FILE...>]
=head1 DESCRIPTION
pgegrep aims to be a small and easy to use program in replacement of the
standard grep utility. Regex support is whatever PGE will allow. It
searches through files line by line and tests if the given pattern matches.
=head1 OPTIONS
=over 4
=item -v
=item --invert-match
print lines not matching PATTERN
=item -V
=item --version
print the version and exit
=item --help
show this help and exit
=item -r
=item --recursive
recursively descend into directories
=item -L
=item --files-without-matches
print a list of files that do not match PATTERN
=item -l
=item --files-with-matches
print a list of files that do match PATTERN
=item -a
=item --text
treat binary files as text.
This uses a basic heuristic to discover if a file is binary or not. Files are
read line by line, and it keeps processing "normally" until a control character
is found, and then stops and goes onto the next file is that line matches.
=item -n
=item --line-number
print the line number for each match
=item -H
=item --with-filename
print the filename for each match
=back
=cut
# Readability improved!
.include 'hllmacros.pir'
# for getstdin and friends
.loadlib 'io_ops'
.sub main :main
.param pmc argv # the script name, then our options.
.local string progname
progname = shift argv
load_bytecode 'Getopt/Obj.pbc'
load_bytecode 'PGE.pbc'
.local pmc getopts
getopts = new [ 'Getopt';'Obj' ]
getopts.'notOptStop'(1)
push getopts, 'with-filename|H'
push getopts, 'files-with-matches|l'
push getopts, 'files-without-matches|L'
push getopts, 'line-number|n'
push getopts, 'text|a'
push getopts, 'recursive|r'
push getopts, 'invert-match|v'
push getopts, 'version|V'
push getopts, 'help'
push_eh handler
.local pmc opts
opts = getopts.'get_options'(argv)
$I0 = defined opts['help']
.If($I0, {
showhelp()
})
$I0 = defined opts['version']
.If($I0, {
showversion()
})
.local int argc
argc = elements argv
.Unless(argc>1, { showhelp() }) # need rule and at least one file
.local string rule
.local pmc p6rule_compile, matchsub
rule = shift argv
p6rule_compile = compreg 'PGE::Perl6Regex'
matchsub = p6rule_compile(rule)
.If(null matchsub, { die 'Unable to compile regex' })
.local int i, filecount
.local string filename
.local pmc File, OS, files, handle
files = new 'ResizableStringArray'
files = argv
filecount = files
# define with-filename if there's more than one file
.If(filecount >= 2, { opts['with-filename'] = 1 })
$P0 = loadlib 'file'
File = new 'File'
$P0 = loadlib 'os'
OS = new 'OS'
# This must be here, or else it'll get filled with junk data we use stdin...
i = 0
.Unless(filecount, {
# no args, use stdin
stdindashhack:
handle = getstdin
filename = '(standard input)'
goto stdinhack
})
.For(, i < filecount, inc i, {
filename = files[i]
.If(filename == '-', {
goto stdindashhack
})
$I1 = File.'is_file'(filename)
.IfElse($I1, {
# Is a file
handle = open filename, 'r'
},{
# Not a file, hopefully a directory
$I1 = File.'is_dir'(filename)
$I0 = defined opts['recursive']
$I1 &= $I0
.Unless($I1, {
printerr "pgegrep: '"
printerr filename
printerr "': Operation not supported.\n"
goto nextfor_0
})
$P0 = OS.'readdir'(filename)
.Foreach($S0, $P0, {
.If($S0 != '.', {
.If($S0 != '..', {
$S1 = filename . '/'
$S0 = $S1 . $S0
$P1 = new 'ResizableStringArray'
$P1[0] = $S0
$I0 = i + 1
splice files, $P1, $I0, 0
}) })
})
filecount = files
goto nextfor_0
})
stdinhack:
checkfile(handle, filename, matchsub, opts)
close handle
nextfor_0:
})
end
handler:
.local pmc exception, pmcmsg
.local string message
.get_results (exception)
pmcmsg = getattribute exception, 'message'
pop_eh
message = pmcmsg
message = "pgegrep: " . message
die message
.end
.sub checkfile
.param pmc handle
.param string filename
.param pmc matchsub
.param pmc opts
.local pmc match
.local string line
.local int lineno, linelen, matched
lineno = 1
matched = 0 # Only used for --files-without-matches
line = readline handle
linelen = length line
.local pmc p6rule_compile, cntrlchar
$S0 = '<+cntrl-[\t\r\n]>'
p6rule_compile = compreg 'PGE::Perl6Regex'
cntrlchar = p6rule_compile($S0)
.For(, linelen, {
line = readline handle
linelen = length line
inc lineno
}, {
match = matchsub(line)
$I1 = istrue match
match = cntrlchar(line)
$I2 = istrue match
$I0 = defined opts['files-without-matches']
.If($I0, {
.If($I1, { matched = 1 })
goto next
})
$I0 = defined opts['files-with-matches']
$I0 = $I0 && $I1
.If($I0, {
say filename
.return()
})
$I0 = defined opts['invert-match']
not $I0
$I1 = xor $I1, $I0
.Unless($I1, {
$I0 = defined opts['text']
$I0 = xor $I0, $I2
.If($I0, {
print 'Binary file '
print filename
say ' matches'
.return()
})
$I0 = defined opts['with-filename']
$I1 = defined opts['recursive']
$I0 = $I0 || $I1
.If($I0, {
print filename
print ':'
})
$I0 = defined opts['line-number']
.If($I0, {
print lineno
print ':'
})
print line
})
#---------
next:
})
$I0 = defined opts['files-without-matches']
.If($I0, { say filename })
.return()
.end
.sub showhelp
print <<'HELP'
Usage: pgegrep [OPTIONS] PATTERN [FILE...]
Search for the Perl 6 Rule PATTERN in each file.
-v --invert-match print lines not matching PATTERN
-V --version print the version and exit
--help show this help and exit
-r --recursive recursively descend into directories
-L --files-without-matches print a list of files that do not match PATTERN
-l --files-with-matches print a list of files that do match PATTERN
-a --text treat binary files as text
-n --line-number print the line number for each match
-H --with-filename print the filename for each match
HELP
end
.end
.sub showversion
print <<'VERSION'
pgegrep v0.0.1
VERSION
end
.end
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir:
