bin/ack

   1 #!/usr/bin/env perl
   2 #
   3 # This file, ack, is generated code.
   4 # Please DO NOT EDIT or send patches for it.
   5 #
   6 # Please take a look at the source from
   7 # http://github.com/petdance/ack
   8 # and submit patches against the individual files
   9 # that build ack.
  10 #
  11
  12 use warnings;
  13 use strict;
  14
  15 our $VERSION = '1.94';
  16 # Check http://betterthangrep.com/ for updates
  17
  18 # These are all our globals.
  19
  20
  21 MAIN: {
  22     if ( $App::Ack::VERSION ne $main::VERSION ) {
  23         App::Ack::die( "Program/library version mismatch\n\t$0 is $main::VERSION\n\t$INC{'App/Ack.pm'} is $App::Ack::VERSION" );
  24     }
  25
  26     # Do preliminary arg checking;
  27     my $env_is_usable = 1;
  28     for ( @ARGV ) {
  29         last if ( $_ eq '--' );
  30
  31         # Priorities! Get the --thpppt checking out of the way.
  32         /^--th[pt]+t+$/ && App::Ack::_thpppt($_);
  33
  34         # See if we want to ignore the environment. (Don't tell Al Gore.)
  35         if ( /^--(no)?env$/ ) {
  36             $env_is_usable = defined $1 ? 0 : 1;
  37         }
  38     }
  39     if ( $env_is_usable ) {
  40         unshift( @ARGV, App::Ack::read_ackrc() );
  41     }
  42     else {
  43         my @keys = ( 'ACKRC', grep { /^ACK_/ } keys %ENV );
  44         delete @ENV{@keys};
  45     }
  46     App::Ack::load_colors();
  47
  48     if ( exists $ENV{ACK_SWITCHES} ) {
  49         App::Ack::warn( 'ACK_SWITCHES is no longer supported.  Use ACK_OPTIONS.' );
  50     }
  51
  52     if ( !@ARGV ) {
  53         App::Ack::show_help();
  54         exit 1;
  55     }
  56
  57     main();
  58 }
  59
  60 sub main {
  61     my $opt = App::Ack::get_command_line_options();
  62
  63     $| = 1 if $opt->{flush}; # Unbuffer the output if flush mode
  64
  65     if ( App::Ack::input_from_pipe() ) {
  66         # We're going into filter mode
  67         for ( qw( f g l ) ) {
  68             $opt->{$_} and App::Ack::die( "Can't use -$_ when acting as a filter." );
  69         }
  70         $opt->{show_filename} = 0;
  71         $opt->{regex} = App::Ack::build_regex( defined $opt->{regex} ? $opt->{regex} : shift @ARGV, $opt );
  72         if ( my $nargs = @ARGV ) {
  73             my $s = $nargs == 1 ? '' : 's';
  74             App::Ack::warn( "Ignoring $nargs argument$s on the command-line while acting as a filter." );
  75         }
  76
  77         my $res = App::Ack::Resource::Basic->new( '-' );
  78         my $nmatches;
  79         if ( $opt->{count} ) {
  80             $nmatches = App::Ack::search_and_list( $res, $opt );
  81         }
  82         else {
  83             # normal searching
  84             $nmatches = App::Ack::search_resource( $res, $opt );
  85         }
  86         $res->close();
  87         App::Ack::exit_from_ack( $nmatches );
  88     }
  89
  90     my $file_matching = $opt->{f} || $opt->{lines};
  91     if ( $file_matching ) {
  92         App::Ack::die( "Can't specify both a regex ($opt->{regex}) and use one of --line, -f or -g." ) if $opt->{regex};
  93     }
  94     else {
  95         $opt->{regex} = App::Ack::build_regex( defined $opt->{regex} ? $opt->{regex} : shift @ARGV, $opt );
  96     }
  97
  98     # check that all regexes do compile fine
  99     App::Ack::check_regex( $_ ) for ( $opt->{regex}, $opt->{G} );
 100
 101     my $what = App::Ack::get_starting_points( \@ARGV, $opt );
 102     my $iter = App::Ack::get_iterator( $what, $opt );
 103     App::Ack::filetype_setup();
 104
 105     my $nmatches = 0;
 106
 107     App::Ack::set_up_pager( $opt->{pager} ) if defined $opt->{pager};
 108     if ( $opt->{f} ) {
 109         $nmatches = App::Ack::print_files( $iter, $opt );
 110     }
 111     elsif ( $opt->{l} || $opt->{count} ) {
 112         $nmatches = App::Ack::print_files_with_matches( $iter, $opt );
 113     }
 114     else {
 115         $nmatches = App::Ack::print_matches( $iter, $opt );
 116     }
 117     close $App::Ack::fh;
 118     App::Ack::exit_from_ack( $nmatches );
 119 }
 120
 121 =head1 NAME
 122
 123 ack - grep-like text finder
 124
 125 =head1 SYNOPSIS
 126
 127     ack [options] PATTERN [FILE...]
 128     ack -f [options] [DIRECTORY...]
 129
 130 =head1 DESCRIPTION
 131
 132 Ack is designed as a replacement for 99% of the uses of F<grep>.
 133
 134 Ack searches the named input FILEs (or standard input if no files are
 135 named, or the file name - is given) for lines containing a match to the
 136 given PATTERN.  By default, ack prints the matching lines.
 137
 138 Ack can also list files that would be searched, without actually searching
 139 them, to let you take advantage of ack's file-type filtering capabilities.
 140
 141 =head1 FILE SELECTION
 142
 143 I<ack> is intelligent about the files it searches.  It knows about
 144 certain file types, based on both the extension on the file and,
 145 in some cases, the contents of the file.  These selections can be
 146 made with the B<--type> option.
 147
 148 With no file selections, I<ack> only searches files of types that
 149 it recognizes.  If you have a file called F<foo.wango>, and I<ack>
 150 doesn't know what a .wango file is, I<ack> won't search it.
 151
 152 The B<-a> option tells I<ack> to select all files, regardless of
 153 type.
 154
 155 Some files will never be selected by I<ack>, even with B<-a>,
 156 including:
 157
 158 =over 4
 159
 160 =item * Backup files: Files matching F<#*#> or ending with F<~>.
 161
 162 =item * Coredumps: Files matching F<core.\d+>
 163
 164 =back
 165
 166 However, I<ack> always searches the files given on the command line,
 167 no matter what type. Furthermore, by specifying the B<-u> option all
 168 files will be searched.
 169
 170 =head1 DIRECTORY SELECTION
 171
 172 I<ack> descends through the directory tree of the starting directories
 173 specified.  However, it will ignore the shadow directories used by
 174 many version control systems, and the build directories used by the
 175 Perl MakeMaker system.  You may add or remove a directory from this
 176 list with the B<--[no]ignore-dir> option. The option may be repeated
 177 to add/remove multiple directories from the ignore list.
 178
 179 For a complete list of directories that do not get searched, run
 180 F<ack --help>.
 181
 182 =head1 WHEN TO USE GREP
 183
 184 I<ack> trumps I<grep> as an everyday tool 99% of the time, but don't
 185 throw I<grep> away, because there are times you'll still need it.
 186
 187 E.g., searching through huge files looking for regexes that can be
 188 expressed with I<grep> syntax should be quicker with I<grep>.
 189
 190 If your script or parent program uses I<grep> C<--quiet> or
 191 C<--silent> or needs exit 2 on IO error, use I<grep>.
 192
 193 =head1 OPTIONS
 194
 195 =over 4
 196
 197 =item B<-a>, B<--all>
 198
 199 Operate on all files, regardless of type (but still skip directories
 200 like F<blib>, F<CVS>, etc.)
 201
 202 =item B<-A I<NUM>>, B<--after-context=I<NUM>>
 203
 204 Print I<NUM> lines of trailing context after matching lines.
 205
 206 =item B<-B I<NUM>>, B<--before-context=I<NUM>>
 207
 208 Print I<NUM> lines of leading context before matching lines.
 209
 210 =item B<-C [I<NUM>]>, B<--context[=I<NUM>]>
 211
 212 Print I<NUM> lines (default 2) of context around matching lines.
 213
 214 =item B<-c>, B<--count>
 215
 216 Suppress normal output; instead print a count of matching lines for
 217 each input file.  If B<-l> is in effect, it will only show the
 218 number of lines for each file that has lines matching.  Without
 219 B<-l>, some line counts may be zeroes.
 220
 221 If combined with B<-h> (B<--no-filename>) ack outputs only one total count.
 222
 223 =item B<--color>, B<--nocolor>
 224
 225 B<--color> highlights the matching text.  B<--nocolor> supresses
 226 the color.  This is on by default unless the output is redirected.
 227
 228 On Windows, this option is off by default unless the
 229 L<Win32::Console::ANSI> module is installed or the C<ACK_PAGER_COLOR>
 230 environment variable is used.
 231
 232 =item B<--color-filename=I<color>>
 233
 234 Sets the color to be used for filenames.
 235
 236 =item B<--color-match=I<color>>
 237
 238 Sets the color to be used for matches.
 239
 240 =item B<--color-lineno=I<color>>
 241
 242 Sets the color to be used for line numbers.
 243
 244 =item B<--column>
 245
 246 Show the column number of the first match.  This is helpful for editors
 247 that can place your cursor at a given position.
 248
 249 =item B<--env>, B<--noenv>
 250
 251 B<--noenv> disables all environment processing. No F<.ackrc> is read
 252 and all environment variables are ignored. By default, F<ack> considers
 253 F<.ackrc> and settings in the environment.
 254
 255 =item B<--flush>
 256
 257 B<--flush> flushes output immediately.  This is off by default
 258 unless ack is running interactively (when output goes to a pipe
 259 or file).
 260
 261 =item B<-f>
 262
 263 Only print the files that would be searched, without actually doing
 264 any searching.  PATTERN must not be specified, or it will be taken as
 265 a path to search.
 266
 267 =item B<--follow>, B<--nofollow>
 268
 269 Follow or don't follow symlinks, other than whatever starting files
 270 or directories were specified on the command line.
 271
 272 This is off by default.
 273
 274 =item B<-G I<REGEX>>
 275
 276 Only paths matching I<REGEX> are included in the search.  The entire
 277 path and filename are matched against I<REGEX>, and I<REGEX> is a
 278 Perl regular expression, not a shell glob.
 279
 280 The options B<-i>, B<-w>, B<-v>, and B<-Q> do not apply to this I<REGEX>.
 281
 282 =item B<-g I<REGEX>>
 283
 284 Print files where the relative path + filename matches I<REGEX>. This option is
 285 a convenience shortcut for B<-f> B<-G I<REGEX>>.
 286
 287 The options B<-i>, B<-w>, B<-v>, and B<-Q> do not apply to this I<REGEX>.
 288
 289 =item B<--group>, B<--nogroup>
 290
 291 B<--group> groups matches by file name with.  This is the default when
 292 used interactively.
 293
 294 B<--nogroup> prints one result per line, like grep.  This is the default
 295 when output is redirected.
 296
 297 =item B<-H>, B<--with-filename>
 298
 299 Print the filename for each match.
 300
 301 =item B<-h>, B<--no-filename>
 302
 303 Suppress the prefixing of filenames on output when multiple files are
 304 searched.
 305
 306 =item B<--help>
 307
 308 Print a short help statement.
 309
 310 =item B<-i>, B<--ignore-case>
 311
 312 Ignore case in the search strings.
 313
 314 This applies only to the PATTERN, not to the regexes given for the B<-g>
 315 and B<-G> options.
 316
 317 =item B<--[no]ignore-dir=I<DIRNAME>>
 318
 319 Ignore directory (as CVS, .svn, etc are ignored). May be used multiple times
 320 to ignore multiple directories. For example, mason users may wish to include
 321 B<--ignore-dir=data>. The B<--noignore-dir> option allows users to search
 322 directories which would normally be ignored (perhaps to research the contents
 323 of F<.svn/props> directories).
 324
 325 The I<DIRNAME> must always be a simple directory name. Nested directories like
 326 F<foo/bar> are NOT supported. You would need to specify B<--ignore-dir=foo> and
 327 then no files from any foo directory are taken into account by ack unless given
 328 explicitly on the command line.
 329
 330 =item B<--line=I<NUM>>
 331
 332 Only print line I<NUM> of each file. Multiple lines can be given with multiple
 333 B<--line> options or as a comma separated list (B<--line=3,5,7>). B<--line=4-7>
 334 also works. The lines are always output in ascending order, no matter the
 335 order given on the command line.
 336
 337 =item B<-l>, B<--files-with-matches>
 338
 339 Only print the filenames of matching files, instead of the matching text.
 340
 341 =item B<-L>, B<--files-without-matches>
 342
 343 Only print the filenames of files that do I<NOT> match. This is equivalent
 344 to specifying B<-l> and B<-v>.
 345
 346 =item B<--match I<REGEX>>
 347
 348 Specify the I<REGEX> explicitly. This is helpful if you don't want to put the
 349 regex as your first argument, e.g. when executing multiple searches over the
 350 same set of files.
 351
 352     # search for foo and bar in given files
 353     ack file1 t/file* --match foo
 354     ack file1 t/file* --match bar
 355
 356 =item B<-m=I<NUM>>, B<--max-count=I<NUM>>
 357
 358 Stop reading a file after I<NUM> matches.
 359
 360 =item B<--man>
 361
 362 Print this manual page.
 363
 364 =item B<-n>, B<--no-recurse>
 365
 366 No descending into subdirectories.
 367
 368 =item B<-o>
 369
 370 Show only the part of each line matching PATTERN (turns off text
 371 highlighting)
 372
 373 =item B<--output=I<expr>>
 374
 375 Output the evaluation of I<expr> for each line (turns off text
 376 highlighting)
 377
 378 =item B<--pager=I<program>>
 379
 380 Direct ack's output through I<program>.  This can also be specified
 381 via the C<ACK_PAGER> and C<ACK_PAGER_COLOR> environment variables.
 382
 383 Using --pager does not suppress grouping and coloring like piping
 384 output on the command-line does.
 385
 386 =item B<--passthru>
 387
 388 Prints all lines, whether or not they match the expression.  Highlighting
 389 will still work, though, so it can be used to highlight matches while
 390 still seeing the entire file, as in:
 391
 392     # Watch a log file, and highlight a certain IP address
 393     $ tail -f ~/access.log | ack --passthru 123.45.67.89
 394
 395 =item B<--print0>
 396
 397 Only works in conjunction with -f, -g, -l or -c (filename output). The filenames
 398 are output separated with a null byte instead of the usual newline. This is
 399 helpful when dealing with filenames that contain whitespace, e.g.
 400
 401     # remove all files of type html
 402     ack -f --html --print0 | xargs -0 rm -f
 403
 404 =item B<-Q>, B<--literal>
 405
 406 Quote all metacharacters in PATTERN, it is treated as a literal.
 407
 408 This applies only to the PATTERN, not to the regexes given for the B<-g>
 409 and B<-G> options.
 410
 411 =item B<-r>, B<-R>, B<--recurse>
 412
 413 Recurse into sub-directories. This is the default and just here for
 414 compatibility with grep. You can also use it for turning B<--no-recurse> off.
 415
 416 =item B<--smart-case>, B<--no-smart-case>
 417
 418 Ignore case in the search strings if PATTERN contains no uppercase
 419 characters. This is similar to C<smartcase> in vim. This option is
 420 off by default.
 421
 422 B<-i> always overrides this option.
 423
 424 This applies only to the PATTERN, not to the regexes given for the
 425 B<-g> and B<-G> options.
 426
 427 =item B<--sort-files>
 428
 429 Sorts the found files lexically.  Use this if you want your file
 430 listings to be deterministic between runs of I<ack>.
 431
 432 =item B<--show-types>
 433
 434 Outputs the filetypes that ack associates with each file.
 435
 436 Works with B<-f> and B<-g> options.
 437
 438 =item B<--thpppt>
 439
 440 Display the all-important Bill The Cat logo.  Note that the exact
 441 spelling of B<--thpppppt> is not important.  It's checked against
 442 a regular expression.
 443
 444 =item B<--type=TYPE>, B<--type=noTYPE>
 445
 446 Specify the types of files to include or exclude from a search.
 447 TYPE is a filetype, like I<perl> or I<xml>.  B<--type=perl> can
 448 also be specified as B<--perl>, and B<--type=noperl> can be done
 449 as B<--noperl>.
 450
 451 If a file is of both type "foo" and "bar", specifying --foo and
 452 --nobar will exclude the file, because an exclusion takes precedence
 453 over an inclusion.
 454
 455 Type specifications can be repeated and are ORed together.
 456
 457 See I<ack --help=types> for a list of valid types.
 458
 459 =item B<--type-add I<TYPE>=I<.EXTENSION>[,I<.EXT2>[,...]]>
 460
 461 Files with the given EXTENSION(s) are recognized as being of (the
 462 existing) type TYPE. See also L</"Defining your own types">.
 463
 464
 465 =item B<--type-set I<TYPE>=I<.EXTENSION>[,I<.EXT2>[,...]]>
 466
 467 Files with the given EXTENSION(s) are recognized as being of type
 468 TYPE. This replaces an existing definition for type TYPE.  See also
 469 L</"Defining your own types">.
 470
 471 =item B<-u>, B<--unrestricted>
 472
 473 All files and directories (including blib/, core.*, ...) are searched,
 474 nothing is skipped. When both B<-u> and B<--ignore-dir> are used, the
 475 B<--ignore-dir> option has no effect.
 476
 477 =item B<-v>, B<--invert-match>
 478
 479 Invert match: select non-matching lines
 480
 481 This applies only to the PATTERN, not to the regexes given for the B<-g>
 482 and B<-G> options.
 483
 484 =item B<--version>
 485
 486 Display version and copyright information.
 487
 488 =item B<-w>, B<--word-regexp>
 489
 490 Force PATTERN to match only whole words.  The PATTERN is wrapped with
 491 C<\b> metacharacters.
 492
 493 This applies only to the PATTERN, not to the regexes given for the B<-g>
 494 and B<-G> options.
 495
 496 =item B<-1>
 497
 498 Stops after reporting first match of any kind.  This is different
 499 from B<--max-count=1> or B<-m1>, where only one match per file is
 500 shown.  Also, B<-1> works with B<-f> and B<-g>, where B<-m> does
 501 not.
 502
 503 =back
 504
 505 =head1 THE .ackrc FILE
 506
 507 The F<.ackrc> file contains command-line options that are prepended
 508 to the command line before processing.  Multiple options may live
 509 on multiple lines.  Lines beginning with a # are ignored.  A F<.ackrc>
 510 might look like this:
 511
 512     # Always sort the files
 513     --sort-files
 514
 515     # Always color, even if piping to a another program
 516     --color
 517
 518     # Use "less -r" as my pager
 519     --pager=less -r
 520
 521 Note that arguments with spaces in them do not need to be quoted,
 522 as they are not interpreted by the shell. Basically, each I<line>
 523 in the F<.ackrc> file is interpreted as one element of C<@ARGV>.
 524
 525 F<ack> looks in your home directory for the F<.ackrc>.  You can
 526 specify another location with the F<ACKRC> variable, below.
 527
 528 If B<--noenv> is specified on the command line, the F<.ackrc> file
 529 is ignored.
 530
 531 =head1 Defining your own types
 532
 533 ack allows you to define your own types in addition to the predefined
 534 types. This is done with command line options that are best put into
 535 an F<.ackrc> file - then you do not have to define your types over and
 536 over again. In the following examples the options will always be shown
 537 on one command line so that they can be easily copy & pasted.
 538
 539 I<ack --perl foo> searches for foo in all perl files. I<ack --help=types>
 540 tells you, that perl files are files ending
 541 in .pl, .pm, .pod or .t. So what if you would like to include .xs
 542 files as well when searching for --perl files? I<ack --type-add perl=.xs --perl foo>
 543 does this for you. B<--type-add> appends
 544 additional extensions to an existing type.
 545
 546 If you want to define a new type, or completely redefine an existing
 547 type, then use B<--type-set>. I<ack --type-set
 548 eiffel=.e,.eiffel> defines the type I<eiffel> to include files with
 549 the extensions .e or .eiffel. So to search for all eiffel files
 550 containing the word Bertrand use I<ack --type-set eiffel=.e,.eiffel --eiffel Bertrand>.
 551 As usual, you can also write B<--type=eiffel>
 552 instead of B<--eiffel>. Negation also works, so B<--noeiffel> excludes
 553 all eiffel files from a search. Redefining also works: I<ack --type-set cc=.c,.h>
 554 and I<.xs> files no longer belong to the type I<cc>.
 555
 556 When defining your own types in the F<.ackrc> file you have to use
 557 the following:
 558
 559   --type-set=eiffel=.e,.eiffel
 560
 561 or writing on separate lines
 562
 563   --type-set
 564   eiffel=.e,.eiffel
 565
 566 The following does B<NOT> work in the F<.ackrc> file:
 567
 568   --type-set eiffel=.e,.eiffel
 569
 570
 571 In order to see all currently defined types, use I<--help types>, e.g.
 572 I<ack --type-set backup=.bak --type-add perl=.perl --help types>
 573
 574 Restrictions:
 575
 576 =over 4
 577
 578 =item
 579
 580 The types 'skipped', 'make', 'binary' and 'text' are considered "builtin" and
 581 cannot be altered.
 582
 583 =item
 584
 585 The shebang line recognition of the types 'perl', 'ruby', 'php', 'python',
 586 'shell' and 'xml' cannot be redefined by I<--type-set>, it is always
 587 active. However, the shebang line is only examined for files where the
 588 extension is not recognised. Therefore it is possible to say
 589 I<ack --type-set perl=.perl --type-set foo=.pl,.pm,.pod,.t --perl --nofoo> and
 590 only find your shiny new I<.perl> files (and all files with unrecognized extension
 591 and perl on the shebang line).
 592
 593 =back
 594
 595 =head1 ENVIRONMENT VARIABLES
 596
 597 For commonly-used ack options, environment variables can make life much easier.
 598 These variables are ignored if B<--noenv> is specified on the command line.
 599
 600 =over 4
 601
 602 =item ACKRC
 603
 604 Specifies the location of the F<.ackrc> file.  If this file doesn't
 605 exist, F<ack> looks in the default location.
 606
 607 =item ACK_OPTIONS
 608
 609 This variable specifies default options to be placed in front of
 610 any explicit options on the command line.
 611
 612 =item ACK_COLOR_FILENAME
 613
 614 Specifies the color of the filename when it's printed in B<--group>
 615 mode.  By default, it's "bold green".
 616
 617 The recognized attributes are clear, reset, dark, bold, underline,
 618 underscore, blink, reverse, concealed black, red, green, yellow,
 619 blue, magenta, on_black, on_red, on_green, on_yellow, on_blue,
 620 on_magenta, on_cyan, and on_white.  Case is not significant.
 621 Underline and underscore are equivalent, as are clear and reset.
 622 The color alone sets the foreground color, and on_color sets the
 623 background color.
 624
 625 This option can also be set with B<--color-filename>.
 626
 627 =item ACK_COLOR_MATCH
 628
 629 Specifies the color of the matching text when printed in B<--color>
 630 mode.  By default, it's "black on_yellow".
 631
 632 This option can also be set with B<--color-match>.
 633
 634 See B<ACK_COLOR_FILENAME> for the color specifications.
 635
 636 =item ACK_COLOR_LINENO
 637
 638 Specifies the color of the line number when printed in B<--color>
 639 mode.  By default, it's "bold yellow".
 640
 641 This option can also be set with B<--color-lineno>.
 642
 643 See B<ACK_COLOR_FILENAME> for the color specifications.
 644
 645 =item ACK_PAGER
 646
 647 Specifies a pager program, such as C<more>, C<less> or C<most>, to which
 648 ack will send its output.
 649
 650 Using C<ACK_PAGER> does not suppress grouping and coloring like
 651 piping output on the command-line does, except that on Windows
 652 ack will assume that C<ACK_PAGER> does not support color.
 653
 654 C<ACK_PAGER_COLOR> overrides C<ACK_PAGER> if both are specified.
 655
 656 =item ACK_PAGER_COLOR
 657
 658 Specifies a pager program that understands ANSI color sequences.
 659 Using C<ACK_PAGER_COLOR> does not suppress grouping and coloring
 660 like piping output on the command-line does.
 661
 662 If you are not on Windows, you never need to use C<ACK_PAGER_COLOR>.
 663
 664 =back
 665
 666 =head1 ACK & OTHER TOOLS
 667
 668 =head2 Vim integration
 669
 670 F<ack> integrates easily with the Vim text editor. Set this in your
 671 F<.vimrc> to use F<ack> instead of F<grep>:
 672
 673     set grepprg=ack\ -a
 674
 675 That examples uses C<-a> to search through all files, but you may
 676 use other default flags. Now you can search with F<ack> and easily
 677 step through the results in Vim:
 678
 679   :grep Dumper perllib
 680
 681 =head2 Emacs integration
 682
 683 Phil Jackson put together an F<ack.el> extension that "provides a
 684 simple compilation mode ... has the ability to guess what files you
 685 want to search for based on the major-mode."
 686
 687 L<http://www.shellarchive.co.uk/content/emacs.html>
 688
 689 =head2 TextMate integration
 690
 691 Pedro Melo is a TextMate user who writes "I spend my day mostly
 692 inside TextMate, and the built-in find-in-project sucks with large
 693 projects.  So I hacked a TextMate command that was using find +
 694 grep to use ack.  The result is the Search in Project with ack, and
 695 you can find it here:
 696 L<http://www.simplicidade.org/notes/archives/2008/03/search_in_proje.html>"
 697
 698 =head2 Shell and Return Code
 699
 700 For greater compatibility with I<grep>, I<ack> in normal use returns
 701 shell return or exit code of 0 only if something is found and 1 if
 702 no match is found.
 703
 704 (Shell exit code 1 is C<$?=256> in perl with C<system> or backticks.)
 705
 706 The I<grep> code 2 for errors is not used.
 707
 708 If C<-f> or C<-g> are specified, then 0 is returned if at least one
 709 file is found.  If no files are found, then 1 is returned.
 710
 711 =cut
 712
 713 =head1 DEBUGGING ACK PROBLEMS
 714
 715 If ack gives you output you're not expecting, start with a few simple steps.
 716
 717 =head2 Use B<--noenv>
 718
 719 Your environment variables and F<.ackrc> may be doing things you're
 720 not expecting, or forgotten you specified.  Use B<--noenv> to ignore
 721 your environment and F<.ackrc>.
 722
 723 =head2 Use B<-f> to see what files you're scanning
 724
 725 The reason I created B<-f> in the first place was as a debugging
 726 tool.  If ack is not finding matches you think it should find, run
 727 F<ack -f> to see what files are being checked.
 728
 729 =head1 TIPS
 730
 731 =head2 Use the F<.ackrc> file.
 732
 733 The F<.ackrc> is the place to put all your options you use most of
 734 the time but don't want to remember.  Put all your --type-add and
 735 --type-set definitions in it.  If you like --smart-case, set it
 736 there, too.  I also set --sort-files there.
 737
 738 =head2 Use F<-f> for working with big codesets
 739
 740 Ack does more than search files.  C<ack -f --perl> will create a
 741 list of all the Perl files in a tree, ideal for sending into F<xargs>.
 742 For example:
 743
 744     # Change all "this" to "that" in all Perl files in a tree.
 745     ack -f --perl | xargs perl -p -i -e's/this/that/g'
 746
 747 or if you prefer:
 748
 749     perl -p -i -e's/this/thatg/' $(ack -f --perl)
 750
 751 =head2 Use F<-Q> when in doubt about metacharacters
 752
 753 If you're searching for something with a regular expression
 754 metacharacter, most often a period in a filename or IP address, add
 755 the -Q to avoid false positives without all the backslashing.  See
 756 the following example for more...
 757
 758 =head2 Use ack to watch log files
 759
 760 Here's one I used the other day to find trouble spots for a website
 761 visitor.  The user had a problem loading F<troublesome.gif>, so I
 762 took the access log and scanned it with ack twice.
 763
 764     ack -Q aa.bb.cc.dd /path/to/access.log | ack -Q -B5 troublesome.gif
 765
 766 The first ack finds only the lines in the Apache log for the given
 767 IP.  The second finds the match on my troublesome GIF, and shows
 768 the previous five lines from the log in each case.
 769
 770 =head2 Share your knowledge
 771
 772 Join the ack-users mailing list.  Send me your tips and I may add
 773 them here.
 774
 775 =head1 FAQ
 776
 777 =head2 Why isn't ack finding a match in (some file)?
 778
 779 Probably because it's of a type that ack doesn't recognize.  ack's
 780 searching behavior is driven by filetype.  B<If ack doesn't know
 781 what kind of file it is, ack ignores the file.>
 782
 783 Use the C<-f> switch to see a list of files that ack will search
 784 for you.
 785
 786 If you want ack to search files that it doesn't recognize, use the
 787 C<-a> switch.
 788
 789 If you want ack to search every file, even ones that it always
 790 ignores like coredumps and backup files, use the C<-u> switch.
 791
 792 =head2 Why does ack ignore unknown files by default?
 793
 794 ack is designed by a programmer, for programmers, for searching
 795 large trees of code.  Most codebases have a lot files in them which
 796 aren't source files (like compiled object files, source control
 797 metadata, etc), and grep wastes a lot of time searching through all
 798 of those as well and returning matches from those files.
 799
 800 That's why ack's behavior of not searching things it doesn't recognize
 801 is one of its greatest strengths: the speed you get from only
 802 searching the things that you want to be looking at.
 803
 804 =head2 Wouldn't it be great if F<ack> did search & replace?
 805
 806 No, ack will always be read-only.  Perl has a perfectly good way
 807 to do search & replace in files, using the C<-i>, C<-p> and C<-n>
 808 switches.
 809
 810 You can certainly use ack to select your files to update.  For
 811 example, to change all "foo" to "bar" in all PHP files, you can do
 812 this from the Unix shell:
 813
 814     $ perl -i -p -e's/foo/bar/g' $(ack -f --php)
 815
 816 =head2 Can you make ack recognize F<.xyz> files?
 817
 818 That's an enhancement.  Please see the section in the manual about
 819 enhancements.
 820
 821 =head2 There's already a program/package called ack.
 822
 823 Yes, I know.
 824
 825 =head2 Why is it called ack if it's called ack-grep?
 826
 827 The name of the program is "ack".  Some packagers have called it
 828 "ack-grep" when creating packages because there's already a package
 829 out there called "ack" that has nothing to do with this ack.
 830
 831 I suggest you make a symlink named F<ack> that points to F<ack-grep>
 832 because one of the crucial benefits of ack is having a name that's
 833 so short and simple to type.
 834
 835 To do that, run this with F<sudo> or as root:
 836
 837    ln -s /usr/bin/ack-grep /usr/bin/ack
 838
 839 =head2 What does F<ack> mean?
 840
 841 Nothing.  I wanted a name that was easy to type and that you could
 842 pronounce as a single syllable.
 843
 844 =head2 Can I do multi-line regexes?
 845
 846 No, ack does not support regexes that match multiple lines.  Doing
 847 so would require reading in the entire file at a time.
 848
 849 If you want to see lines near your match, use the C<--A>, C<--B>
 850 and C<--C> switches for displaying context.
 851
 852 =head1 AUTHOR
 853
 854 Andy Lester, C<< <andy at petdance.com> >>
 855
 856 =head1 BUGS
 857
 858 Please report any bugs or feature requests to the issues list at
 859 Github: L<http://github.com/petdance/ack/issues>
 860
 861 =head1 ENHANCEMENTS
 862
 863 All enhancement requests MUST first be posted to the ack-users
 864 mailing list at L<http://groups.google.com/group/ack-users>.  I
 865 will not consider a request without it first getting seen by other
 866 ack users.  This includes requests for new filetypes.
 867
 868 There is a list of enhancements I want to make to F<ack> in the ack
 869 issues list at Github: L<http://github.com/petdance/ack/issues>
 870
 871 Patches are always welcome, but patches with tests get the most
 872 attention.
 873
 874 =head1 SUPPORT
 875
 876 Support for and information about F<ack> can be found at:
 877
 878 =over 4
 879
 880 =item * The ack homepage
 881
 882 L<http://betterthangrep.com/>
 883
 884 =item * The ack issues list at Github
 885
 886 L<http://github.com/petdance/ack/issues>
 887
 888 =item * AnnoCPAN: Annotated CPAN documentation
 889
 890 L<http://annocpan.org/dist/ack>
 891
 892 =item * CPAN Ratings
 893
 894 L<http://cpanratings.perl.org/d/ack>
 895
 896 =item * Search CPAN
 897
 898 L<http://search.cpan.org/dist/ack>
 899
 900 =item * Git source repository
 901
 902 L<http://github.com/petdance/ack>
 903
 904 =back
 905
 906 =head1 ACKNOWLEDGEMENTS
 907
 908 How appropriate to have I<ack>nowledgements!
 909
 910 Thanks to everyone who has contributed to ack in any way, including
 911 Nick Hooey,
 912 Bo Borgerson,
 913 Mark Szymanski,
 914 Marq Schneider,
 915 Packy Anderson,
 916 JR Boyens,
 917 Dan Sully,
 918 Ryan Niebur,
 919 Kent Fredric,
 920 Mike Morearty,
 921 Ingmar Vanhassel,
 922 Eric Van Dewoestine,
 923 Sitaram Chamarty,
 924 Adam James,
 925 Richard Carlsson,
 926 Pedro Melo,
 927 AJ Schuster,
 928 Phil Jackson,
 929 Michael Schwern,
 930 Jan Dubois,
 931 Christopher J. Madsen,
 932 Matthew Wickline,
 933 David Dyck,
 934 Jason Porritt,
 935 Jjgod Jiang,
 936 Thomas Klausner,
 937 Uri Guttman,
 938 Peter Lewis,
 939 Kevin Riggle,
 940 Ori Avtalion,
 941 Torsten Blix,
 942 Nigel Metheringham,
 943 GE<aacute>bor SzabE<oacute>,
 944 Tod Hagan,
 945 Michael Hendricks,
 946 E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason,
 947 Piers Cawley,
 948 Stephen Steneker,
 949 Elias Lutfallah,
 950 Mark Leighton Fisher,
 951 Matt Diephouse,
 952 Christian Jaeger,
 953 Bill Sully,
 954 Bill Ricker,
 955 David Golden,
 956 Nilson Santos F. Jr,
 957 Elliot Shank,
 958 Merijn Broeren,
 959 Uwe Voelker,
 960 Rick Scott,
 961 Ask BjE<oslash>rn Hansen,
 962 Jerry Gay,
 963 Will Coleda,
 964 Mike O'Regan,
 965 Slaven ReziE<0x107>,
 966 Mark Stosberg,
 967 David Alan Pisoni,
 968 Adriano Ferreira,
 969 James Keenan,
 970 Leland Johnson,
 971 Ricardo Signes
 972 and Pete Krawczyk.
 973
 974 =head1 COPYRIGHT & LICENSE
 975
 976 Copyright 2005-2010 Andy Lester.
 977
 978 This program is free software; you can redistribute it and/or modify
 979 it under the terms of the Artistic License v2.0.
 980
 981 =cut
 982 package File::Next;
 983
 984 use strict;
 985 use warnings;
 986
 987
 988 our $VERSION = '1.06';
 989
 990
 991
 992 use File::Spec ();
 993
 994
 995 our $name; # name of the current file
 996 our $dir;  # dir of the current file
 997
 998 our %files_defaults;
 999 our %skip_dirs;
1000
1001 BEGIN {
1002     %files_defaults = (
1003         file_filter     => undef,
1004         descend_filter  => undef,
1005         error_handler   => sub { CORE::die @_ },
1006         sort_files      => undef,
1007         follow_symlinks => 1,
1008     );
1009     %skip_dirs = map {($_,1)} (File::Spec->curdir, File::Spec->updir);
1010 }
1011
1012
1013 sub files {
1014     ($_[0] eq __PACKAGE__) && die 'File::Next::files must not be invoked as File::Next->files';
1015
1016     my ($parms,@queue) = _setup( \%files_defaults, @_ );
1017     my $filter = $parms->{file_filter};
1018
1019     return sub {
1020         while (@queue) {
1021             my ($dir,$file,$fullpath) = splice( @queue, 0, 3 );
1022             if ( -f $fullpath ) {
1023                 if ( $filter ) {
1024                     local $_ = $file;
1025                     local $File::Next::dir = $dir;
1026                     local $File::Next::name = $fullpath;
1027                     next if not $filter->();
1028                 }
1029                 return wantarray ? ($dir,$file,$fullpath) : $fullpath;
1030             }
1031             elsif ( -d _ ) {
1032                 unshift( @queue, _candidate_files( $parms, $fullpath ) );
1033             }
1034         } # while
1035
1036         return;
1037     }; # iterator
1038 }
1039
1040
1041
1042
1043
1044
1045
1046 sub sort_standard($$)   { return $_[0]->[1] cmp $_[1]->[1] }
1047 sub sort_reverse($$)    { return $_[1]->[1] cmp $_[0]->[1] }
1048
1049 sub reslash {
1050     my $path = shift;
1051
1052     my @parts = split( /\//, $path );
1053
1054     return $path if @parts < 2;
1055
1056     return File::Spec->catfile( @parts );
1057 }
1058
1059
1060
1061 sub _setup {
1062     my $defaults = shift;
1063     my $passed_parms = ref $_[0] eq 'HASH' ? {%{+shift}} : {}; # copy parm hash
1064
1065     my %passed_parms = %{$passed_parms};
1066
1067     my $parms = {};
1068     for my $key ( keys %{$defaults} ) {
1069         $parms->{$key} =
1070             exists $passed_parms{$key}
1071                 ? delete $passed_parms{$key}
1072                 : $defaults->{$key};
1073     }
1074
1075     # Any leftover keys are bogus
1076     for my $badkey ( keys %passed_parms ) {
1077         my $sub = (caller(1))[3];
1078         $parms->{error_handler}->( "Invalid option passed to $sub(): $badkey" );
1079     }
1080
1081     # If it's not a code ref, assume standard sort
1082     if ( $parms->{sort_files} && ( ref($parms->{sort_files}) ne 'CODE' ) ) {
1083         $parms->{sort_files} = \&sort_standard;
1084     }
1085     my @queue;
1086
1087     for ( @_ ) {
1088         my $start = reslash( $_ );
1089         if (-d $start) {
1090             push @queue, ($start,undef,$start);
1091         }
1092         else {
1093             push @queue, (undef,$start,$start);
1094         }
1095     }
1096
1097     return ($parms,@queue);
1098 }
1099
1100
1101 sub _candidate_files {
1102     my $parms = shift;
1103     my $dir = shift;
1104
1105     my $dh;
1106     if ( !opendir $dh, $dir ) {
1107         $parms->{error_handler}->( "$dir: $!" );
1108         return;
1109     }
1110
1111     my @newfiles;
1112     my $descend_filter = $parms->{descend_filter};
1113     my $follow_symlinks = $parms->{follow_symlinks};
1114     my $sort_sub = $parms->{sort_files};
1115
1116     for my $file ( grep { !exists $skip_dirs{$_} } readdir $dh ) {
1117         my $has_stat;
1118
1119         # Only do directory checking if we have a descend_filter
1120         my $fullpath = File::Spec->catdir( $dir, $file );
1121         if ( !$follow_symlinks ) {
1122             next if -l $fullpath;
1123             $has_stat = 1;
1124         }
1125
1126         if ( $descend_filter ) {
1127             if ( $has_stat ? (-d _) : (-d $fullpath) ) {
1128                 local $File::Next::dir = $fullpath;
1129                 local $_ = $file;
1130                 next if not $descend_filter->();
1131             }
1132         }
1133         if ( $sort_sub ) {
1134             push( @newfiles, [ $dir, $file, $fullpath ] );
1135         }
1136         else {
1137             push( @newfiles, $dir, $file, $fullpath );
1138         }
1139     }
1140     closedir $dh;
1141
1142     if ( $sort_sub ) {
1143         return map { @{$_} } sort $sort_sub @newfiles;
1144     }
1145
1146     return @newfiles;
1147 }
1148
1149
1150 1; # End of File::Next
1151 package App::Ack;
1152
1153 use warnings;
1154 use strict;
1155
1156
1157
1158
1159 our $VERSION;
1160 our $COPYRIGHT;
1161 BEGIN {
1162     $VERSION = '1.94';
1163     $COPYRIGHT = 'Copyright 2005-2010 Andy Lester.';
1164 }
1165
1166 our $fh;
1167
1168 BEGIN {
1169     $fh = *STDOUT;
1170 }
1171
1172
1173 our %types;
1174 our %type_wanted;
1175 our %mappings;
1176 our %ignore_dirs;
1177
1178 our $input_from_pipe;
1179 our $output_to_pipe;
1180
1181 our $dir_sep_chars;
1182 our $is_cygwin;
1183 our $is_windows;
1184
1185 use File::Spec ();
1186 use File::Glob ':glob';
1187 use Getopt::Long ();
1188
1189 BEGIN {
1190     %ignore_dirs = (
1191         '.bzr'              => 'Bazaar',
1192         '.cdv'              => 'Codeville',
1193         '~.dep'             => 'Interface Builder',
1194         '~.dot'             => 'Interface Builder',
1195         '~.nib'             => 'Interface Builder',
1196         '~.plst'            => 'Interface Builder',
1197         '.git'              => 'Git',
1198         '.hg'               => 'Mercurial',
1199         '.pc'               => 'quilt',
1200         '.svn'              => 'Subversion',
1201         _MTN                => 'Monotone',
1202         blib                => 'Perl module building',
1203         CVS                 => 'CVS',
1204         RCS                 => 'RCS',
1205         SCCS                => 'SCCS',
1206         _darcs              => 'darcs',
1207         _sgbak              => 'Vault/Fortress',
1208         'autom4te.cache'    => 'autoconf',
1209         'cover_db'          => 'Devel::Cover',
1210         _build              => 'Module::Build',
1211     );
1212
1213     %mappings = (
1214         actionscript => [qw( as mxml )],
1215         ada         => [qw( ada adb ads )],
1216         asm         => [qw( asm s )],
1217         batch       => [qw( bat cmd )],
1218         binary      => q{Binary files, as defined by Perl's -B op (default: off)},
1219         cc          => [qw( c h xs )],
1220         cfmx        => [qw( cfc cfm cfml )],
1221         clojure     => [qw( clj )],
1222         cpp         => [qw( cpp cc cxx m hpp hh h hxx )],
1223         csharp      => [qw( cs )],
1224         css         => [qw( css )],
1225         delphi      => [qw( pas int dfm nfm dof dpk dproj groupproj bdsgroup bdsproj )],
1226         elisp       => [qw( el )],
1227         erlang      => [qw( erl hrl )],
1228         fortran     => [qw( f f77 f90 f95 f03 for ftn fpp )],
1229         go          => [qw( go )],
1230         groovy      => [qw( groovy gtmpl gpp grunit )],
1231         haskell     => [qw( hs lhs )],
1232         hh          => [qw( h )],
1233         html        => [qw( htm html shtml xhtml )],
1234         java        => [qw( java properties )],
1235         js          => [qw( js )],
1236         jsp         => [qw( jsp jspx jhtm jhtml )],
1237         lisp        => [qw( lisp lsp )],
1238         lua         => [qw( lua )],
1239         make        => q{Makefiles (including *.mk and *.mak)},
1240         mason       => [qw( mas mhtml mpl mtxt )],
1241         objc        => [qw( m h )],
1242         objcpp      => [qw( mm h )],
1243         ocaml       => [qw( ml mli )],
1244         parrot      => [qw( pir pasm pmc ops pod pg tg )],
1245         perl        => [qw( pl pm pod t )],
1246         php         => [qw( php phpt php3 php4 php5 phtml)],
1247         plone       => [qw( pt cpt metadata cpy py )],
1248         python      => [qw( py )],
1249         rake        => q{Rakefiles},
1250         ruby        => [qw( rb rhtml rjs rxml erb rake spec )],
1251         scala       => [qw( scala )],
1252         scheme      => [qw( scm ss )],
1253         shell       => [qw( sh bash csh tcsh ksh zsh )],
1254         skipped     => q{Files, but not directories, normally skipped by ack (default: off)},
1255         smalltalk   => [qw( st )],
1256         sql         => [qw( sql ctl )],
1257         tcl         => [qw( tcl itcl itk )],
1258         tex         => [qw( tex cls sty )],
1259         text        => q{Text files, as defined by Perl's -T op (default: off)},
1260         tt          => [qw( tt tt2 ttml )],
1261         vb          => [qw( bas cls frm ctl vb resx )],
1262         verilog     => [qw( v vh sv )],
1263         vhdl        => [qw( vhd vhdl )],
1264         vim         => [qw( vim )],
1265         yaml        => [qw( yaml yml )],
1266         xml         => [qw( xml dtd xsl xslt ent )],
1267     );
1268
1269     while ( my ($type,$exts) = each %mappings ) {
1270         if ( ref $exts ) {
1271             for my $ext ( @{$exts} ) {
1272                 push( @{$types{$ext}}, $type );
1273             }
1274         }
1275     }
1276     # add manually Makefile extensions
1277     push @{$types{$_}}, 'make' for qw{ mk mak };
1278
1279     # These have to be checked before any filehandle diddling.
1280     $output_to_pipe  = not -t *STDOUT;
1281     $input_from_pipe = -p STDIN;
1282
1283     $is_cygwin       = ($^O eq 'cygwin');
1284     $is_windows      = ($^O =~ /MSWin32/);
1285     $dir_sep_chars   = $is_windows ? quotemeta( '\\/' ) : quotemeta( File::Spec->catfile( '', '' ) );
1286 }
1287
1288
1289 sub read_ackrc {
1290     my @files = ( $ENV{ACKRC} );
1291     my @dirs =
1292         $is_windows
1293             ? ( $ENV{HOME}, $ENV{USERPROFILE} )
1294             : ( '~', $ENV{HOME} );
1295     for my $dir ( grep { defined } @dirs ) {
1296         for my $file ( '.ackrc', '_ackrc' ) {
1297             push( @files, bsd_glob( "$dir/$file", GLOB_TILDE ) );
1298         }
1299     }
1300     for my $filename ( @files ) {
1301         if ( defined $filename && -e $filename ) {
1302             open( my $fh, '<', $filename ) or App::Ack::die( "$filename: $!\n" );
1303             my @lines = grep { /./ && !/^\s*#/ } <$fh>;
1304             chomp @lines;
1305             close $fh or App::Ack::die( "$filename: $!\n" );
1306
1307             # get rid of leading and trailing whitespaces
1308             for ( @lines ) {
1309                s/^\s+//;
1310                s/\s+$//;
1311             }
1312
1313             return @lines;
1314         }
1315     }
1316
1317     return;
1318 }
1319
1320
1321 sub get_command_line_options {
1322     my %opt = (
1323         pager => $ENV{ACK_PAGER_COLOR} || $ENV{ACK_PAGER},
1324     );
1325
1326     my $getopt_specs = {
1327         1                       => sub { $opt{1} = $opt{m} = 1 },
1328         'A|after-context=i'     => \$opt{after_context},
1329         'B|before-context=i'    => \$opt{before_context},
1330         'C|context:i'           => sub { shift; my $val = shift; $opt{before_context} = $opt{after_context} = ($val || 2) },
1331         'a|all-types'           => \$opt{all},
1332         'break!'                => \$opt{break},
1333         c                       => \$opt{count},
1334         'color|colour!'         => \$opt{color},
1335         'color-match=s'         => \$ENV{ACK_COLOR_MATCH},
1336         'color-filename=s'      => \$ENV{ACK_COLOR_FILENAME},
1337         'color-lineno=s'        => \$ENV{ACK_COLOR_LINENO},
1338         'column!'               => \$opt{column},
1339         count                   => \$opt{count},
1340         'env!'                  => sub { }, # ignore this option, it is handled beforehand
1341         f                       => \$opt{f},
1342         flush                   => \$opt{flush},
1343         'follow!'               => \$opt{follow},
1344         'g=s'                   => sub { shift; $opt{G} = shift; $opt{f} = 1 },
1345         'G=s'                   => \$opt{G},
1346         'group!'                => sub { shift; $opt{heading} = $opt{break} = shift },
1347         'heading!'              => \$opt{heading},
1348         'h|no-filename'         => \$opt{h},
1349         'H|with-filename'       => \$opt{H},
1350         'i|ignore-case'         => \$opt{i},
1351         'invert-file-match'     => \$opt{invert_file_match},
1352         'lines=s'               => sub { shift; my $val = shift; push @{$opt{lines}}, $val },
1353         'l|files-with-matches'  => \$opt{l},
1354         'L|files-without-matches' => sub { $opt{l} = $opt{v} = 1 },
1355         'm|max-count=i'         => \$opt{m},
1356         'match=s'               => \$opt{regex},
1357         'n|no-recurse'          => \$opt{n},
1358         o                       => sub { $opt{output} = '$&' },
1359         'output=s'              => \$opt{output},
1360         'pager=s'               => \$opt{pager},
1361         'nopager'               => sub { $opt{pager} = undef },
1362         'passthru'              => \$opt{passthru},
1363         'print0'                => \$opt{print0},
1364         'Q|literal'             => \$opt{Q},
1365         'r|R|recurse'           => sub { $opt{n} = 0 },
1366         'show-types'            => \$opt{show_types},
1367         'smart-case!'           => \$opt{smart_case},
1368         'sort-files'            => \$opt{sort_files},
1369         'u|unrestricted'        => \$opt{u},
1370         'v|invert-match'        => \$opt{v},
1371         'w|word-regexp'         => \$opt{w},
1372
1373         'ignore-dirs=s'         => sub { shift; my $dir = remove_dir_sep( shift ); $ignore_dirs{$dir} = '--ignore-dirs' },
1374         'noignore-dirs=s'       => sub { shift; my $dir = remove_dir_sep( shift ); delete $ignore_dirs{$dir} },
1375
1376         'version'   => sub { print_version_statement(); exit; },
1377         'help|?:s'  => sub { shift; show_help(@_); exit; },
1378         'help-types'=> sub { show_help_types(); exit; },
1379         'man'       => sub {
1380             require Pod::Usage;
1381             Pod::Usage::pod2usage({
1382                 -verbose => 2,
1383                 -exitval => 0,
1384             });
1385         },
1386
1387         'type=s'    => sub {
1388             # Whatever --type=xxx they specify, set it manually in the hash
1389             my $dummy = shift;
1390             my $type = shift;
1391             my $wanted = ($type =~ s/^no//) ? 0 : 1; # must not be undef later
1392
1393             if ( exists $type_wanted{ $type } ) {
1394                 $type_wanted{ $type } = $wanted;
1395             }
1396             else {
1397                 App::Ack::die( qq{Unknown --type "$type"} );
1398             }
1399         }, # type sub
1400     };
1401
1402     # Stick any default switches at the beginning, so they can be overridden
1403     # by the command line switches.
1404     unshift @ARGV, split( ' ', $ENV{ACK_OPTIONS} ) if defined $ENV{ACK_OPTIONS};
1405
1406     # first pass through options, looking for type definitions
1407     def_types_from_ARGV();
1408
1409     for my $i ( filetypes_supported() ) {
1410         $getopt_specs->{ "$i!" } = \$type_wanted{ $i };
1411     }
1412
1413
1414     my $parser = Getopt::Long::Parser->new();
1415     $parser->configure( 'bundling', 'no_ignore_case', );
1416     $parser->getoptions( %{$getopt_specs} ) or
1417         App::Ack::die( 'See ack --help, ack --help-types or ack --man for options.' );
1418
1419     my $to_screen = not output_to_pipe();
1420     my %defaults = (
1421         all            => 0,
1422         color          => $to_screen,
1423         follow         => 0,
1424         break          => $to_screen,
1425         heading        => $to_screen,
1426         before_context => 0,
1427         after_context  => 0,
1428     );
1429     if ( $is_windows && $defaults{color} && not $ENV{ACK_PAGER_COLOR} ) {
1430         if ( $ENV{ACK_PAGER} || not eval { require Win32::Console::ANSI } ) {
1431             $defaults{color} = 0;
1432         }
1433     }
1434     if ( $to_screen && $ENV{ACK_PAGER_COLOR} ) {
1435         $defaults{color} = 1;
1436     }
1437
1438     while ( my ($key,$value) = each %defaults ) {
1439         if ( not defined $opt{$key} ) {
1440             $opt{$key} = $value;
1441         }
1442     }
1443
1444     if ( defined $opt{m} && $opt{m} <= 0 ) {
1445         App::Ack::die( '-m must be greater than zero' );
1446     }
1447
1448     for ( qw( before_context after_context ) ) {
1449         if ( defined $opt{$_} && $opt{$_} < 0 ) {
1450             App::Ack::die( "--$_ may not be negative" );
1451         }
1452     }
1453
1454     if ( defined( my $val = $opt{output} ) ) {
1455         $opt{output} = eval qq[ sub { "$val" } ];
1456     }
1457     if ( defined( my $l = $opt{lines} ) ) {
1458         # --line=1 --line=5 is equivalent to --line=1,5
1459         my @lines = split( /,/, join( ',', @{$l} ) );
1460
1461         # --line=1-3 is equivalent to --line=1,2,3
1462         @lines = map {
1463             my @ret;
1464             if ( /-/ ) {
1465                 my ($from, $to) = split /-/, $_;
1466                 if ( $from > $to ) {
1467                     App::Ack::warn( "ignoring --line=$from-$to" );
1468                     @ret = ();
1469                 }
1470                 else {
1471                     @ret = ( $from .. $to );
1472                 }
1473             }
1474             else {
1475                 @ret = ( $_ );
1476             };
1477             @ret
1478         } @lines;
1479
1480         if ( @lines ) {
1481             my %uniq;
1482             @uniq{ @lines } = ();
1483             $opt{lines} = [ sort { $a <=> $b } keys %uniq ];   # numerical sort and each line occurs only once!
1484         }
1485         else {
1486             # happens if there are only ignored --line directives
1487             App::Ack::die( 'All --line options are invalid.' );
1488         }
1489     }
1490
1491     return \%opt;
1492 }
1493
1494
1495 sub def_types_from_ARGV {
1496     my @typedef;
1497
1498     my $parser = Getopt::Long::Parser->new();
1499         # pass_through   => leave unrecognized command line arguments alone
1500         # no_auto_abbrev => otherwise -c is expanded and not left alone
1501     $parser->configure( 'no_ignore_case', 'pass_through', 'no_auto_abbrev' );
1502     $parser->getoptions(
1503         'type-set=s' => sub { shift; push @typedef, ['c', shift] },
1504         'type-add=s' => sub { shift; push @typedef, ['a', shift] },
1505     ) or App::Ack::die( 'See ack --help or ack --man for options.' );
1506
1507     for my $td (@typedef) {
1508         my ($type, $ext) = split /=/, $td->[1];
1509
1510         if ( $td->[0] eq 'c' ) {
1511             # type-set
1512             if ( exists $mappings{$type} ) {
1513                 # can't redefine types 'make', 'skipped', 'text' and 'binary'
1514                 App::Ack::die( qq{--type-set: Builtin type "$type" cannot be changed.} )
1515                     if ref $mappings{$type} ne 'ARRAY';
1516
1517                 delete_type($type);
1518             }
1519         }
1520         else {
1521             # type-add
1522
1523             # can't append to types 'make', 'skipped', 'text' and 'binary'
1524             App::Ack::die( qq{--type-add: Builtin type "$type" cannot be changed.} )
1525                 if exists $mappings{$type} && ref $mappings{$type} ne 'ARRAY';
1526
1527             App::Ack::warn( qq{--type-add: Type "$type" does not exist, creating with "$ext" ...} )
1528                 unless exists $mappings{$type};
1529         }
1530
1531         my @exts = split /,/, $ext;
1532         s/^\.// for @exts;
1533
1534         if ( !exists $mappings{$type} || ref($mappings{$type}) eq 'ARRAY' ) {
1535             push @{$mappings{$type}}, @exts;
1536             for my $e ( @exts ) {
1537                 push @{$types{$e}}, $type;
1538             }
1539         }
1540         else {
1541             App::Ack::die( qq{Cannot append to type "$type".} );
1542         }
1543     }
1544
1545     return;
1546 }
1547
1548
1549 sub delete_type {
1550     my $type = shift;
1551
1552     App::Ack::die( qq{Internal error: Cannot delete builtin type "$type".} )
1553         unless ref $mappings{$type} eq 'ARRAY';
1554
1555     delete $mappings{$type};
1556     delete $type_wanted{$type};
1557     for my $ext ( keys %types ) {
1558         $types{$ext} = [ grep { $_ ne $type } @{$types{$ext}} ];
1559     }
1560 }
1561
1562
1563 sub ignoredir_filter {
1564     return !exists $ignore_dirs{$_} && !exists $ignore_dirs{$File::Next::dir};
1565 }
1566
1567
1568 sub remove_dir_sep {
1569     my $path = shift;
1570     $path =~ s/[$dir_sep_chars]$//;
1571
1572     return $path;
1573 }
1574
1575
1576 use constant TEXT => 'text';
1577
1578 sub filetypes {
1579     my $filename = shift;
1580
1581     my $basename = $filename;
1582     $basename =~ s{.*[$dir_sep_chars]}{};
1583
1584     return 'skipped' unless is_searchable( $basename );
1585
1586     my $lc_basename = lc $basename;
1587     return ('make',TEXT)        if $lc_basename eq 'makefile' || $lc_basename eq 'gnumakefile';
1588     return ('rake','ruby',TEXT) if $lc_basename eq 'rakefile';
1589
1590     # If there's an extension, look it up
1591     if ( $filename =~ m{\.([^\.$dir_sep_chars]+)$}o ) {
1592         my $ref = $types{lc $1};
1593         return (@{$ref},TEXT) if $ref;
1594     }
1595
1596     # At this point, we can't tell from just the name.  Now we have to
1597     # open it and look inside.
1598
1599     return unless -e $filename;
1600     # From Elliot Shank:
1601     #     I can't see any reason that -r would fail on these-- the ACLs look
1602     #     fine, and no program has any of them open, so the busted Windows
1603     #     file locking model isn't getting in there.  If I comment the if
1604     #     statement out, everything works fine
1605     # So, for cygwin, don't bother trying to check for readability.
1606     if ( !$is_cygwin ) {
1607         if ( !-r $filename ) {
1608             App::Ack::warn( "$filename: Permission denied" );
1609             return;
1610         }
1611     }
1612
1613     return 'binary' if -B $filename;
1614
1615     # If there's no extension, or we don't recognize it, check the shebang line
1616     my $fh;
1617     if ( !open( $fh, '<', $filename ) ) {
1618         App::Ack::warn( "$filename: $!" );
1619         return;
1620     }
1621     my $header = <$fh>;
1622     close $fh;
1623
1624     if ( $header =~ /^#!/ ) {
1625         return ($1,TEXT)       if $header =~ /\b(ruby|p(?:erl|hp|ython))\b/;
1626         return ('shell',TEXT)  if $header =~ /\b(?:ba|t?c|k|z)?sh\b/;
1627     }
1628     else {
1629         return ('xml',TEXT)    if $header =~ /\Q<?xml /i;
1630     }
1631
1632     return (TEXT);
1633 }
1634
1635
1636 sub is_searchable {
1637     my $filename = shift;
1638
1639     # If these are updated, update the --help message
1640     return if $filename =~ /[.]bak$/;
1641     return if $filename =~ /~$/;
1642     return if $filename =~ m{^#.*#$}o;
1643     return if $filename =~ m{^core\.\d+$}o;
1644     return if $filename =~ m{[._].*\.swp$}o;
1645
1646     return 1;
1647 }
1648
1649
1650 sub build_regex {
1651     my $str = shift;
1652     my $opt = shift;
1653
1654     defined $str or App::Ack::die( 'No regular expression found.' );
1655
1656     $str = quotemeta( $str ) if $opt->{Q};
1657     if ( $opt->{w} ) {
1658         $str = "\\b$str" if $str =~ /^\w/;
1659         $str = "$str\\b" if $str =~ /\w$/;
1660     }
1661
1662     my $regex_is_lc = $str eq lc $str;
1663     if ( $opt->{i} || ($opt->{smart_case} && $regex_is_lc) ) {
1664         $str = "(?i)$str";
1665     }
1666
1667     return $str;
1668 }
1669
1670
1671 sub check_regex {
1672     my $regex = shift;
1673
1674     return unless defined $regex;
1675
1676     eval { qr/$regex/ };
1677     if ($@) {
1678         (my $error = $@) =~ s/ at \S+ line \d+.*//;
1679         chomp($error);
1680         App::Ack::die( "Invalid regex '$regex':\n  $error" );
1681     }
1682
1683     return;
1684 }
1685
1686
1687
1688
1689 sub warn {
1690     return CORE::warn( _my_program(), ': ', @_, "\n" );
1691 }
1692
1693
1694 sub die {
1695     return CORE::die( _my_program(), ': ', @_, "\n" );
1696 }
1697
1698 sub _my_program {
1699     require File::Basename;
1700     return File::Basename::basename( $0 );
1701 }
1702
1703
1704
1705 sub filetypes_supported {
1706     return keys %mappings;
1707 }
1708
1709 sub _get_thpppt {
1710     my $y = q{_   /|,\\'!.x',=(www)=,   U   };
1711     $y =~ tr/,x!w/\nOo_/;
1712     return $y;
1713 }
1714
1715 sub _thpppt {
1716     my $y = _get_thpppt();
1717     App::Ack::print( "$y ack $_[0]!\n" );
1718     exit 0;
1719 }
1720
1721 sub _key {
1722     my $str = lc shift;
1723     $str =~ s/[^a-z]//g;
1724
1725     return $str;
1726 }
1727
1728
1729 sub show_help {
1730     my $help_arg = shift || 0;
1731
1732     return show_help_types() if $help_arg =~ /^types?/;
1733
1734     my $ignore_dirs = _listify( sort { _key($a) cmp _key($b) } keys %ignore_dirs );
1735
1736     App::Ack::print( <<"END_OF_HELP" );
1737 Usage: ack [OPTION]... PATTERN [FILE]
1738
1739 Search for PATTERN in each source file in the tree from cwd on down.
1740 If [FILES] is specified, then only those files/directories are checked.
1741 ack may also search STDIN, but only if no FILE are specified, or if
1742 one of FILES is "-".
1743
1744 Default switches may be specified in ACK_OPTIONS environment variable or
1745 an .ackrc file. If you want no dependency on the environment, turn it
1746 off with --noenv.
1747
1748 Example: ack -i select
1749
1750 Searching:
1751   -i, --ignore-case     Ignore case distinctions in PATTERN
1752   --[no]smart-case      Ignore case distinctions in PATTERN,
1753                         only if PATTERN contains no upper case
1754                         Ignored if -i is specified
1755   -v, --invert-match    Invert match: select non-matching lines
1756   -w, --word-regexp     Force PATTERN to match only whole words
1757   -Q, --literal         Quote all metacharacters; PATTERN is literal
1758
1759 Search output:
1760   --line=NUM            Only print line(s) NUM of each file
1761   -l, --files-with-matches
1762                         Only print filenames containing matches
1763   -L, --files-without-matches
1764                         Only print filenames with no matches
1765   -o                    Show only the part of a line matching PATTERN
1766                         (turns off text highlighting)
1767   --passthru            Print all lines, whether matching or not
1768   --output=expr         Output the evaluation of expr for each line
1769                         (turns off text highlighting)
1770   --match PATTERN       Specify PATTERN explicitly.
1771   -m, --max-count=NUM   Stop searching in each file after NUM matches
1772   -1                    Stop searching after one match of any kind
1773   -H, --with-filename   Print the filename for each match
1774   -h, --no-filename     Suppress the prefixing filename on output
1775   -c, --count           Show number of lines matching per file
1776   --column              Show the column number of the first match
1777
1778   -A NUM, --after-context=NUM
1779                         Print NUM lines of trailing context after matching
1780                         lines.
1781   -B NUM, --before-context=NUM
1782                         Print NUM lines of leading context before matching
1783                         lines.
1784   -C [NUM], --context[=NUM]
1785                         Print NUM lines (default 2) of output context.
1786
1787   --print0              Print null byte as separator between filenames,
1788                         only works with -f, -g, -l, -L or -c.
1789
1790 File presentation:
1791   --pager=COMMAND       Pipes all ack output through COMMAND.  For example,
1792                         --pager="less -R".  Ignored if output is redirected.
1793   --nopager             Do not send output through a pager.  Cancels any
1794                         setting in ~/.ackrc, ACK_PAGER or ACK_PAGER_COLOR.
1795   --[no]heading         Print a filename heading above each file's results.
1796                         (default: on when used interactively)
1797   --[no]break           Print a break between results from different files.
1798                         (default: on when used interactively)
1799   --group               Same as --heading --break
1800   --nogroup             Same as --noheading --nobreak
1801   --[no]color           Highlight the matching text (default: on unless
1802                         output is redirected, or on Windows)
1803   --[no]colour          Same as --[no]color
1804   --color-filename=COLOR
1805   --color-match=COLOR
1806   --color-lineno=COLOR  Set the color for filenames, matches, and line numbers.
1807   --flush               Flush output immediately, even when ack is used
1808                         non-interactively (when output goes to a pipe or
1809                         file).
1810
1811 File finding:
1812   -f                    Only print the files found, without searching.
1813                         The PATTERN must not be specified.
1814   -g REGEX              Same as -f, but only print files matching REGEX.
1815   --sort-files          Sort the found files lexically.
1816   --invert-file-match   Print/search handle files that do not match -g/-G.
1817   --show-types          Show which types each file has.
1818
1819 File inclusion/exclusion:
1820   -a, --all-types       All file types searched;
1821                         Ignores CVS, .svn and other ignored directories
1822   -u, --unrestricted    All files and directories searched
1823   --[no]ignore-dir=name Add/Remove directory from the list of ignored dirs
1824   -r, -R, --recurse     Recurse into subdirectories (ack's default behavior)
1825   -n, --no-recurse      No descending into subdirectories
1826   -G REGEX              Only search files that match REGEX
1827
1828   --perl                Include only Perl files.
1829   --type=perl           Include only Perl files.
1830   --noperl              Exclude Perl files.
1831   --type=noperl         Exclude Perl files.
1832                         See "ack --help type" for supported filetypes.
1833
1834   --type-set TYPE=.EXTENSION[,.EXT2[,...]]
1835                         Files with the given EXTENSION(s) are recognized as
1836                         being of type TYPE. This replaces an existing
1837                         definition for type TYPE.
1838   --type-add TYPE=.EXTENSION[,.EXT2[,...]]
1839                         Files with the given EXTENSION(s) are recognized as
1840                         being of (the existing) type TYPE
1841
1842   --[no]follow          Follow symlinks.  Default is off.
1843
1844   Directories ignored by default:
1845     $ignore_dirs
1846
1847   Files not checked for type:
1848     /~\$/           - Unix backup files
1849     /#.+#\$/        - Emacs swap files
1850     /[._].*\\.swp\$/ - Vi(m) swap files
1851     /core\\.\\d+\$/   - core dumps
1852
1853 Miscellaneous:
1854   --noenv               Ignore environment variables and ~/.ackrc
1855   --help                This help
1856   --man                 Man page
1857   --version             Display version & copyright
1858   --thpppt              Bill the Cat
1859
1860 Exit status is 0 if match, 1 if no match.
1861
1862 This is version $VERSION of ack.
1863 END_OF_HELP
1864
1865     return;
1866  }
1867
1868
1869
1870 sub show_help_types {
1871     App::Ack::print( <<'END_OF_HELP' );
1872 Usage: ack [OPTION]... PATTERN [FILES]
1873
1874 The following is the list of filetypes supported by ack.  You can
1875 specify a file type with the --type=TYPE format, or the --TYPE
1876 format.  For example, both --type=perl and --perl work.
1877
1878 Note that some extensions may appear in multiple types.  For example,
1879 .pod files are both Perl and Parrot.
1880
1881 END_OF_HELP
1882
1883     my @types = filetypes_supported();
1884     my $maxlen = 0;
1885     for ( @types ) {
1886         $maxlen = length if $maxlen < length;
1887     }
1888     for my $type ( sort @types ) {
1889         next if $type =~ /^-/; # Stuff to not show
1890         my $ext_list = $mappings{$type};
1891
1892         if ( ref $ext_list ) {
1893             $ext_list = join( ' ', map { ".$_" } @{$ext_list} );
1894         }
1895         App::Ack::print( sprintf( "    --[no]%-*.*s %s\n", $maxlen, $maxlen, $type, $ext_list ) );
1896     }
1897
1898     return;
1899 }
1900
1901 sub _listify {
1902     my @whats = @_;
1903
1904     return '' if !@whats;
1905
1906     my $end = pop @whats;
1907     my $str = @whats ? join( ', ', @whats ) . " and $end" : $end;
1908
1909     no warnings 'once';
1910     require Text::Wrap;
1911     $Text::Wrap::columns = 75;
1912     return Text::Wrap::wrap( '', '    ', $str );
1913 }
1914
1915
1916 sub get_version_statement {
1917     require Config;
1918
1919     my $copyright = get_copyright();
1920     my $this_perl = $Config::Config{perlpath};
1921     if ($^O ne 'VMS') {
1922         my $ext = $Config::Config{_exe};
1923         $this_perl .= $ext unless $this_perl =~ m/$ext$/i;
1924     }
1925     my $ver = sprintf( '%vd', $^V );
1926
1927     return <<"END_OF_VERSION";
1928 ack $VERSION
1929 Running under Perl $ver at $this_perl
1930
1931 $copyright
1932
1933 This program is free software.  You may modify or distribute it
1934 under the terms of the Artistic License v2.0.
1935 END_OF_VERSION
1936 }
1937
1938
1939 sub print_version_statement {
1940     App::Ack::print( get_version_statement() );
1941
1942     return;
1943 }
1944
1945
1946 sub get_copyright {
1947     return $COPYRIGHT;
1948 }
1949
1950
1951 sub load_colors {
1952     eval 'use Term::ANSIColor ()';
1953
1954     $ENV{ACK_COLOR_MATCH}    ||= 'black on_yellow';
1955     $ENV{ACK_COLOR_FILENAME} ||= 'bold green';
1956     $ENV{ACK_COLOR_LINENO}   ||= 'bold yellow';
1957
1958     return;
1959 }
1960
1961
1962 sub is_interesting {
1963     return if /^\./;
1964
1965     my $include;
1966
1967     for my $type ( filetypes( $File::Next::name ) ) {
1968         if ( defined $type_wanted{$type} ) {
1969             if ( $type_wanted{$type} ) {
1970                 $include = 1;
1971             }
1972             else {
1973                 return;
1974             }
1975         }
1976     }
1977
1978     return $include;
1979 }
1980
1981
1982
1983 # print subs added in order to make it easy for a third party
1984 # module (such as App::Wack) to redefine the display methods
1985 # and show the results in a different way.
1986 sub print                   { print {$fh} @_ }
1987 sub print_first_filename    { App::Ack::print( $_[0], "\n" ) }
1988 sub print_blank_line        { App::Ack::print( "\n" ) }
1989 sub print_separator         { App::Ack::print( "--\n" ) }
1990 sub print_filename          { App::Ack::print( $_[0], $_[1] ) }
1991 sub print_line_no           { App::Ack::print( $_[0], $_[1] ) }
1992 sub print_column_no         { App::Ack::print( $_[0], $_[1] ) }
1993 sub print_count {
1994     my $filename = shift;
1995     my $nmatches = shift;
1996     my $ors = shift;
1997     my $count = shift;
1998     my $show_filename = shift;
1999
2000     if ($show_filename) {
2001         App::Ack::print( $filename );
2002         App::Ack::print( ':', $nmatches ) if $count;
2003     }
2004     else {
2005         App::Ack::print( $nmatches ) if $count;
2006     }
2007     App::Ack::print( $ors );
2008 }
2009
2010 sub print_count0 {
2011     my $filename = shift;
2012     my $ors = shift;
2013     my $show_filename = shift;
2014
2015     if ($show_filename) {
2016         App::Ack::print( $filename, ':0', $ors );
2017     }
2018     else {
2019         App::Ack::print( '0', $ors );
2020     }
2021 }
2022
2023
2024
2025 {
2026     my $filename;
2027     my $regex;
2028     my $display_filename;
2029
2030     my $keep_context;
2031
2032     my $last_output_line;             # number of the last line that has been output
2033     my $any_output;                   # has there been any output for the current file yet
2034     my $context_overall_output_count; # has there been any output at all
2035
2036 sub search_resource {
2037     my $res = shift;
2038     my $opt = shift;
2039
2040     $filename = $res->name();
2041
2042     my $v = $opt->{v};
2043     my $passthru = $opt->{passthru};
2044     my $max = $opt->{m};
2045     my $nmatches = 0;
2046
2047     $display_filename = undef;
2048
2049     # for --line processing
2050     my $has_lines = 0;
2051     my @lines;
2052     if ( defined $opt->{lines} ) {
2053         $has_lines = 1;
2054         @lines = ( @{$opt->{lines}}, -1 );
2055         undef $regex; # Don't match when printing matching line
2056     }
2057     else {
2058         $regex = qr/$opt->{regex}/;
2059     }
2060
2061     # for context processing
2062     $last_output_line = -1;
2063     $any_output = 0;
2064     my $before_context = $opt->{before_context};
2065     my $after_context  = $opt->{after_context};
2066
2067     $keep_context = ($before_context || $after_context) && !$passthru;
2068
2069     my @before;
2070     my $before_starts_at_line;
2071     my $after = 0; # number of lines still to print after a match
2072
2073     while ( $res->next_text ) {
2074         # XXX Optimize away the case when there are no more @lines to find.
2075         # XXX $has_lines, $passthru and $v never change.  Optimize.
2076         if ( $has_lines
2077                ? $. != $lines[0]  # $lines[0] should be a scalar
2078                : $v ? m/$regex/ : !m/$regex/ ) {
2079             if ( $passthru ) {
2080                 App::Ack::print( $_ );
2081                 next;
2082             }
2083
2084             if ( $keep_context ) {
2085                 if ( $after ) {
2086                     print_match_or_context( $opt, 0, $., $-[0], $+[0], $_ );
2087                     $after--;
2088                 }
2089                 elsif ( $before_context ) {
2090                     if ( @before ) {
2091                         if ( @before >= $before_context ) {
2092                             shift @before;
2093                             ++$before_starts_at_line;
2094                         }
2095                     }
2096                     else {
2097                         $before_starts_at_line = $.;
2098                     }
2099                     push @before, $_;
2100                 }
2101                 last if $max && ( $nmatches >= $max ) && !$after;
2102             }
2103             next;
2104         } # not a match
2105
2106         ++$nmatches;
2107
2108         # print an empty line as a divider before first line in each file (not before the first file)
2109         if ( !$any_output && $opt->{show_filename} && $opt->{break} && defined( $context_overall_output_count ) ) {
2110             App::Ack::print_blank_line();
2111         }
2112
2113         shift @lines if $has_lines;
2114
2115         if ( $res->is_binary ) {
2116             App::Ack::print( "Binary file $filename matches\n" );
2117             last;
2118         }
2119         if ( $keep_context ) {
2120             if ( @before ) {
2121                 print_match_or_context( $opt, 0, $before_starts_at_line, $-[0], $+[0], @before );
2122                 @before = ();
2123                 $before_starts_at_line = 0;
2124             }
2125             if ( $max && $nmatches > $max ) {
2126                 --$after;
2127             }
2128             else {
2129                 $after = $after_context;
2130             }
2131         }
2132         print_match_or_context( $opt, 1, $., $-[0], $+[0], $_ );
2133
2134         last if $max && ( $nmatches >= $max ) && !$after;
2135     } # while
2136
2137     return $nmatches;
2138 }   # search_resource()
2139
2140
2141
2142 sub print_match_or_context {
2143     my $opt         = shift; # opts array
2144     my $is_match    = shift; # is there a match on the line?
2145     my $line_no     = shift;
2146     my $match_start = shift;
2147     my $match_end   = shift;
2148
2149     my $color         = $opt->{color};
2150     my $heading       = $opt->{heading};
2151     my $show_filename = $opt->{show_filename};
2152     my $show_column   = $opt->{column};
2153
2154     if ( $show_filename ) {
2155         if ( not defined $display_filename ) {
2156             $display_filename =
2157                 $color
2158                     ? Term::ANSIColor::colored( $filename, $ENV{ACK_COLOR_FILENAME} )
2159                     : $filename;
2160             if ( $heading && !$any_output ) {
2161                 App::Ack::print_first_filename($display_filename);
2162             }
2163         }
2164     }
2165
2166     my $sep = $is_match ? ':' : '-';
2167     my $output_func = $opt->{output};
2168     for ( @_ ) {
2169         if ( $keep_context && !$output_func ) {
2170             if ( ( $last_output_line != $line_no - 1 ) &&
2171                 ( $any_output || ( !$heading && defined( $context_overall_output_count ) ) ) ) {
2172                 App::Ack::print_separator();
2173             }
2174             # to ensure separators between different files when --noheading
2175
2176             $last_output_line = $line_no;
2177         }
2178
2179         if ( $show_filename ) {
2180             App::Ack::print_filename($display_filename, $sep) if not $heading;
2181             my $display_line_no =
2182                 $color
2183                     ? Term::ANSIColor::colored( $line_no, $ENV{ACK_COLOR_LINENO} )
2184                     : $line_no;
2185             App::Ack::print_line_no($display_line_no, $sep);
2186         }
2187
2188         if ( $output_func ) {
2189             while ( /$regex/go ) {
2190                 App::Ack::print( $output_func->() . "\n" );
2191             }
2192         }
2193         else {
2194             if ( $color && $is_match && $regex &&
2195                  s/$regex/Term::ANSIColor::colored( substr($_, $-[0], $+[0] - $-[0]), $ENV{ACK_COLOR_MATCH} )/eg ) {
2196                 # At the end of the line reset the color and remove newline
2197                 s/[\r\n]*\z/\e[0m\e[K/;
2198             }
2199             else {
2200                 # remove any kind of newline at the end of the line
2201                 s/[\r\n]*\z//;
2202             }
2203             if ( $show_column ) {
2204                 App::Ack::print_column_no( $match_start+1, $sep );
2205             }
2206             App::Ack::print($_ . "\n");
2207         }
2208         $any_output = 1;
2209         ++$context_overall_output_count;
2210         ++$line_no;
2211     }
2212
2213     return;
2214 } # print_match_or_context()
2215
2216 } # scope around search_resource() and print_match_or_context()
2217
2218
2219 TOTAL_COUNT_SCOPE: {
2220 my $total_count;
2221
2222 sub get_total_count {
2223     return $total_count;
2224 }
2225
2226 sub reset_total_count {
2227     $total_count = 0;
2228 }
2229
2230
2231 sub search_and_list {
2232     my $res = shift;
2233     my $opt = shift;
2234
2235     my $nmatches = 0;
2236     my $count = $opt->{count};
2237     my $ors = $opt->{print0} ? "\0" : "\n"; # output record separator
2238     my $show_filename = $opt->{show_filename};
2239
2240     my $regex = qr/$opt->{regex}/;
2241
2242     if ( $opt->{v} ) {
2243         while ( $res->next_text ) {
2244             if ( /$regex/ ) {
2245                 return 0 unless $count;
2246             }
2247             else {
2248                 ++$nmatches;
2249             }
2250         }
2251     }
2252     else {
2253         while ( $res->next_text ) {
2254             if ( /$regex/ ) {
2255                 ++$nmatches;
2256                 last unless $count;
2257             }
2258         }
2259     }
2260
2261     if ( $opt->{show_total} ) {
2262         $total_count += $nmatches;
2263     }
2264     else {
2265         if ( $nmatches ) {
2266             App::Ack::print_count( $res->name, $nmatches, $ors, $count, $show_filename );
2267         }
2268         elsif ( $count && !$opt->{l} ) {
2269             App::Ack::print_count0( $res->name, $ors, $show_filename );
2270         }
2271     }
2272
2273     return $nmatches ? 1 : 0;
2274 }   # search_and_list()
2275
2276 } # scope around $total_count
2277
2278
2279
2280 sub filetypes_supported_set {
2281     return grep { defined $type_wanted{$_} && ($type_wanted{$_} == 1) } filetypes_supported();
2282 }
2283
2284
2285
2286 sub print_files {
2287     my $iter = shift;
2288     my $opt = shift;
2289
2290     my $ors = $opt->{print0} ? "\0" : "\n";
2291
2292     my $nmatches = 0;
2293     while ( defined ( my $file = $iter->() ) ) {
2294         App::Ack::print $file, $opt->{show_types} ? " => " . join( ',', filetypes( $file ) ) : (),  $ors;
2295         $nmatches++;
2296         last if $opt->{1};
2297     }
2298
2299     return $nmatches;
2300 }
2301
2302
2303 sub print_files_with_matches {
2304     my $iter = shift;
2305     my $opt = shift;
2306
2307     # if we have -l and only 1 file given on command line (this means
2308     # show_filename is set to 0), we want to see the filename nevertheless
2309     $opt->{show_filename} = 1 if $opt->{l};
2310
2311     $opt->{show_filename} = 0 if $opt->{h};
2312     $opt->{show_filename} = 1 if $opt->{H};
2313
2314     # abuse options to hand in the show_total parameter to search_and_list
2315     $opt->{show_total} = $opt->{count} && !$opt->{show_filename};
2316     reset_total_count();
2317
2318     my $nmatches = 0;
2319     while ( defined ( my $filename = $iter->() ) ) {
2320         my $repo = App::Ack::Repository::Basic->new( $filename );
2321         my $res;
2322         while ( $res = $repo->next_resource() ) {
2323             $nmatches += search_and_list( $res, $opt );
2324             $res->close();
2325             last if $nmatches && $opt->{1};
2326         }
2327         $repo->close();
2328     }
2329
2330     if ( $nmatches && $opt->{show_total} ) {
2331         App::Ack::print_count('', get_total_count(), "\n", 1, 0  )
2332     }
2333
2334     return $nmatches;
2335 }
2336
2337
2338 sub print_matches {
2339     my $iter = shift;
2340     my $opt = shift;
2341
2342     $opt->{show_filename} = 0 if $opt->{h};
2343     $opt->{show_filename} = 1 if $opt->{H};
2344
2345     my $nmatches = 0;
2346     while ( defined ( my $filename = $iter->() ) ) {
2347         my $repo;
2348         my $tarballs_work = 0;
2349         if ( $tarballs_work && $filename =~ /\.tar\.gz$/ ) {
2350             App::Ack::die( 'Not working here yet' );
2351             require App::Ack::Repository::Tar; # XXX Error checking
2352             $repo = App::Ack::Repository::Tar->new( $filename );
2353         }
2354         else {
2355             $repo = App::Ack::Repository::Basic->new( $filename );
2356         }
2357         $repo or next;
2358
2359         while ( my $res = $repo->next_resource() ) {
2360             my $needs_line_scan;
2361             if ( $opt->{regex} && !$opt->{passthru} ) {
2362                 $needs_line_scan = $res->needs_line_scan( $opt );
2363                 if ( $needs_line_scan ) {
2364                     $res->reset();
2365                 }
2366             }
2367             else {
2368                 $needs_line_scan = 1;
2369             }
2370             if ( $needs_line_scan ) {
2371                 $nmatches += search_resource( $res, $opt );
2372             }
2373             $res->close();
2374         }
2375         last if $nmatches && $opt->{1};
2376         $repo->close();
2377     }
2378     return  $nmatches;
2379 }
2380
2381
2382 sub filetype_setup {
2383     my $filetypes_supported_set = filetypes_supported_set();
2384     # If anyone says --no-whatever, we assume all other types must be on.
2385     if ( !$filetypes_supported_set ) {
2386         for my $i ( keys %type_wanted ) {
2387             $type_wanted{$i} = 1 unless ( defined( $type_wanted{$i} ) || $i eq 'binary' || $i eq 'text' || $i eq 'skipped' );
2388         }
2389     }
2390     return;
2391 }
2392
2393
2394 EXPAND_FILENAMES_SCOPE: {
2395     my $filter;
2396
2397     sub expand_filenames {
2398         my $argv = shift;
2399
2400         my $attr;
2401         my @files;
2402
2403         foreach my $pattern ( @{$argv} ) {
2404             my @results = bsd_glob( $pattern );
2405
2406             if (@results == 0) {
2407                 @results = $pattern; # Glob didn't match, pass it thru unchanged
2408             }
2409             elsif ( (@results > 1) or ($results[0] ne $pattern) ) {
2410                 if (not defined $filter) {
2411                     eval 'require Win32::File;';
2412                     if ($@) {
2413                         $filter = 0;
2414                     }
2415                     else {
2416                         $filter = Win32::File::HIDDEN()|Win32::File::SYSTEM();
2417                     }
2418                 } # end unless we've tried to load Win32::File
2419                 if ( $filter ) {
2420                     # Filter out hidden and system files:
2421                     @results = grep { not(Win32::File::GetAttributes($_, $attr) and $attr & $filter) } @results;
2422                     App::Ack::warn( "$pattern: Matched only hidden files" ) unless @results;
2423                 } # end if we can filter by file attributes
2424             } # end elsif this pattern got expanded
2425
2426             push @files, @results;
2427         } # end foreach pattern
2428
2429         return \@files;
2430     } # end expand_filenames
2431 } # EXPAND_FILENAMES_SCOPE
2432
2433
2434
2435 sub get_starting_points {
2436     my $argv = shift;
2437     my $opt = shift;
2438
2439     my @what;
2440
2441     if ( @{$argv} ) {
2442         @what = @{ $is_windows ? expand_filenames($argv) : $argv };
2443         $_ = File::Next::reslash( $_ ) for @what;
2444
2445         # Show filenames unless we've specified one single file
2446         $opt->{show_filename} = (@what > 1) || (!-f $what[0]);
2447     }
2448     else {
2449         @what = '.'; # Assume current directory
2450         $opt->{show_filename} = 1;
2451     }
2452
2453     for my $start_point (@what) {
2454         App::Ack::warn( "$start_point: No such file or directory" ) unless -e $start_point;
2455     }
2456     return \@what;
2457 }
2458
2459 sub _match {
2460     my ( $target, $expression, $invert_flag ) = @_;
2461
2462     if ( $invert_flag ) {
2463         return $target !~ $expression;
2464     }
2465     else {
2466         return $target =~ $expression;
2467     }
2468 }
2469
2470
2471 sub get_iterator {
2472     my $what = shift;
2473     my $opt  = shift;
2474
2475     # Starting points are always searched, no matter what
2476     my %starting_point = map { ($_ => 1) } @{$what};
2477
2478     my $g_regex = defined $opt->{G} ? qr/$opt->{G}/ : undef;
2479     my $file_filter;
2480
2481     if ( $g_regex ) {
2482         $file_filter
2483             = $opt->{u}   ? sub { _match( $File::Next::name, qr/$g_regex/, $opt->{invert_file_match} ) }    # XXX Maybe this should be a 1, no?
2484             : $opt->{all} ? sub { $starting_point{ $File::Next::name } || ( _match( $File::Next::name, qr/$g_regex/, $opt->{invert_file_match} ) && is_searchable( $_ ) ) }
2485             :               sub { $starting_point{ $File::Next::name } || ( _match( $File::Next::name, qr/$g_regex/, $opt->{invert_file_match} ) && is_interesting( @ _) ) }
2486             ;
2487     }
2488     else {
2489         $file_filter
2490             = $opt->{u}   ? sub {1}
2491             : $opt->{all} ? sub { $starting_point{ $File::Next::name } || is_searchable( $_ ) }
2492             :               sub { $starting_point{ $File::Next::name } || is_interesting( @_ ) }
2493             ;
2494     }
2495
2496     my $descend_filter
2497         = $opt->{n} ? sub {0}
2498         : $opt->{u} ? sub {1}
2499         : \&ignoredir_filter;
2500
2501     my $iter =
2502         File::Next::files( {
2503             file_filter     => $file_filter,
2504             descend_filter  => $descend_filter,
2505             error_handler   => sub { my $msg = shift; App::Ack::warn( $msg ) },
2506             sort_files      => $opt->{sort_files},
2507             follow_symlinks => $opt->{follow},
2508         }, @{$what} );
2509     return $iter;
2510 }
2511
2512
2513 sub set_up_pager {
2514     my $command = shift;
2515
2516     return if App::Ack::output_to_pipe();
2517
2518     my $pager;
2519     if ( not open( $pager, '|-', $command ) ) {
2520         App::Ack::die( qq{Unable to pipe to pager "$command": $!} );
2521     }
2522     $fh = $pager;
2523
2524     return;
2525 }
2526
2527
2528 sub input_from_pipe {
2529     return $input_from_pipe;
2530 }
2531
2532
2533
2534 sub output_to_pipe {
2535     return $output_to_pipe;
2536 }
2537
2538
2539 sub exit_from_ack {
2540     my $nmatches = shift;
2541
2542     my $rc = $nmatches ? 0 : 1;
2543     exit $rc;
2544 }
2545
2546
2547
2548 1; # End of App::Ack
2549 package App::Ack::Repository;
2550
2551
2552 use warnings;
2553 use strict;
2554
2555 sub FAIL {
2556     require Carp;
2557     Carp::confess( 'Must be overloaded' );
2558 }
2559
2560
2561 sub new {
2562     FAIL();
2563 }
2564
2565
2566 sub next_resource {
2567     FAIL();
2568 }
2569
2570
2571 sub close {
2572     FAIL();
2573 }
2574
2575 1;
2576 package App::Ack::Resource;
2577
2578
2579 use warnings;
2580 use strict;
2581
2582 sub FAIL {
2583     require Carp;
2584     Carp::confess( 'Must be overloaded' );
2585 }
2586
2587
2588 sub new {
2589     FAIL();
2590 }
2591
2592
2593 sub name {
2594     FAIL();
2595 }
2596
2597
2598 sub is_binary {
2599     FAIL();
2600 }
2601
2602
2603
2604 sub needs_line_scan {
2605     FAIL();
2606 }
2607
2608
2609 sub reset {
2610     FAIL();
2611 }
2612
2613
2614 sub next_text {
2615     FAIL();
2616 }
2617
2618
2619 sub close {
2620     FAIL();
2621 }
2622
2623 1;
2624 package App::Ack::Plugin::Basic;
2625
2626
2627
2628 package App::Ack::Resource::Basic;
2629
2630
2631 use warnings;
2632 use strict;
2633
2634
2635 our @ISA = qw( App::Ack::Resource );
2636
2637
2638 sub new {
2639     my $class    = shift;
2640     my $filename = shift;
2641
2642     my $self = bless {
2643         filename        => $filename,
2644         fh              => undef,
2645         could_be_binary => undef,
2646         opened          => undef,
2647         id              => undef,
2648     }, $class;
2649
2650     if ( $self->{filename} eq '-' ) {
2651         $self->{fh} = *STDIN;
2652         $self->{could_be_binary} = 0;
2653     }
2654     else {
2655         if ( !open( $self->{fh}, '<', $self->{filename} ) ) {
2656             App::Ack::warn( "$self->{filename}: $!" );
2657             return;
2658         }
2659         $self->{could_be_binary} = 1;
2660     }
2661
2662     return $self;
2663 }
2664
2665
2666 sub name {
2667     my $self = shift;
2668
2669     return $self->{filename};
2670 }
2671
2672
2673 sub is_binary {
2674     my $self = shift;
2675
2676     if ( $self->{could_be_binary} ) {
2677         return -B $self->{filename};
2678     }
2679
2680     return 0;
2681 }
2682
2683
2684
2685 sub needs_line_scan {
2686     my $self  = shift;
2687     my $opt   = shift;
2688
2689     return 1 if $opt->{v};
2690
2691     my $size = -s $self->{fh};
2692     if ( $size == 0 ) {
2693         return 0;
2694     }
2695     elsif ( $size > 100_000 ) {
2696         return 1;
2697     }
2698
2699     my $buffer;
2700     my $rc = sysread( $self->{fh}, $buffer, $size );
2701     if ( not defined $rc ) {
2702         App::Ack::warn( "$self->{filename}: $!" );
2703         return 1;
2704     }
2705     return 0 unless $rc && ( $rc == $size );
2706
2707     my $regex = $opt->{regex};
2708     return $buffer =~ /$regex/m;
2709 }
2710
2711
2712 sub reset {
2713     my $self = shift;
2714
2715     seek( $self->{fh}, 0, 0 )
2716         or App::Ack::warn( "$self->{filename}: $!" );
2717
2718     return;
2719 }
2720
2721
2722 sub next_text {
2723     if ( defined ($_ = readline $_[0]->{fh}) ) {
2724         $. = ++$_[0]->{line};
2725         return 1;
2726     }
2727
2728     return;
2729 }
2730
2731
2732 sub close {
2733     my $self = shift;
2734
2735     if ( not close $self->{fh} ) {
2736         App::Ack::warn( $self->name() . ": $!" );
2737     }
2738
2739     return;
2740 }
2741
2742 package App::Ack::Repository::Basic;
2743
2744
2745 our @ISA = qw( App::Ack::Repository );
2746
2747
2748 use warnings;
2749 use strict;
2750
2751 sub new {
2752     my $class    = shift;
2753     my $filename = shift;
2754
2755     my $self = bless {
2756         filename => $filename,
2757         nexted   => 0,
2758     }, $class;
2759
2760     return $self;
2761 }
2762
2763
2764 sub next_resource {
2765     my $self = shift;
2766
2767     return if $self->{nexted};
2768     $self->{nexted} = 1;
2769
2770     return App::Ack::Resource::Basic->new( $self->{filename} );
2771 }
2772
2773
2774 sub close {
2775 }
2776
2777
2778
2779 1;