App::Ack - A container for functions for the ack program

package App::Ack;

use warnings;
use strict;

use File::Next 0.40;

use App::Ack::Plugin::Basic;

our $VERSION;
our $COPYRIGHT;
BEGIN {
    $VERSION = '1.94';
    $COPYRIGHT = 'Copyright 2005-2010 Andy Lester.';
}

our $fh;

BEGIN {
    $fh = *STDOUT;
}


our %types;
our %type_wanted;
our %mappings;
our %ignore_dirs;

our $input_from_pipe;
our $output_to_pipe;

our $dir_sep_chars;
our $is_cygwin;
our $is_windows;

use File::Spec ();
use File::Glob ':glob';
use Getopt::Long ();

BEGIN {
    %ignore_dirs = (
        '.bzr'              => 'Bazaar',
        '.cdv'              => 'Codeville',
        '~.dep'             => 'Interface Builder',
        '~.dot'             => 'Interface Builder',
        '~.nib'             => 'Interface Builder',
        '~.plst'            => 'Interface Builder',
        '.git'              => 'Git',
        '.hg'               => 'Mercurial',
        '.pc'               => 'quilt',
        '.svn'              => 'Subversion',
        _MTN                => 'Monotone',
        blib                => 'Perl module building',
        CVS                 => 'CVS',
        RCS                 => 'RCS',
        SCCS                => 'SCCS',
        _darcs              => 'darcs',
        _sgbak              => 'Vault/Fortress',
        'autom4te.cache'    => 'autoconf',
        'cover_db'          => 'Devel::Cover',
        _build              => 'Module::Build',
    );

    %mappings = (
        actionscript => [qw( as mxml )],
        ada         => [qw( ada adb ads )],
        asm         => [qw( asm s )],
        batch       => [qw( bat cmd )],
        binary      => q{Binary files, as defined by Perl's -B op (default: off)},
        cc          => [qw( c h xs )],
        cfmx        => [qw( cfc cfm cfml )],
        clojure     => [qw( clj )],
        cpp         => [qw( cpp cc cxx m hpp hh h hxx )],
        csharp      => [qw( cs )],
        css         => [qw( css )],
        delphi      => [qw( pas int dfm nfm dof dpk dproj groupproj bdsgroup bdsproj )],
        elisp       => [qw( el )],
        erlang      => [qw( erl hrl )],
        fortran     => [qw( f f77 f90 f95 f03 for ftn fpp )],
        go          => [qw( go )],
        haskell     => [qw( hs lhs )],
        hh          => [qw( h )],
        html        => [qw( htm html shtml xhtml )],
        java        => [qw( java properties )],
        js          => [qw( js )],
        jsp         => [qw( jsp jspx jhtm jhtml )],
        lisp        => [qw( lisp lsp )],
        lua         => [qw( lua )],
        make        => q{Makefiles (including *.mk and *.mak)},
        mason       => [qw( mas mhtml mpl mtxt )],
        objc        => [qw( m h )],
        objcpp      => [qw( mm h )],
        ocaml       => [qw( ml mli )],
        parrot      => [qw( pir pasm pmc ops pod pg tg )],
        perl        => [qw( pl pm pod t )],
        php         => [qw( php phpt php3 php4 php5 phtml)],
        plone       => [qw( pt cpt metadata cpy py )],
        python      => [qw( py )],
        rake        => q{Rakefiles},
        ruby        => [qw( rb rhtml rjs rxml erb rake spec )],
        scala       => [qw( scala )],
        scheme      => [qw( scm ss )],
        shell       => [qw( sh bash csh tcsh ksh zsh )],
        skipped     => q{Files, but not directories, normally skipped by ack (default: off)},
        smalltalk   => [qw( st )],
        sql         => [qw( sql ctl )],
        tcl         => [qw( tcl itcl itk )],
        tex         => [qw( tex cls sty )],
        text        => q{Text files, as defined by Perl's -T op (default: off)},
        tt          => [qw( tt tt2 ttml )],
        vb          => [qw( bas cls frm ctl vb resx )],
        verilog     => [qw( v vh sv )],
        vhdl        => [qw( vhd vhdl )],
        vim         => [qw( vim )],
        yaml        => [qw( yaml yml )],
        xml         => [qw( xml dtd xsl xslt ent )],
    );

    while ( my ($type,$exts) = each %mappings ) {
        if ( ref $exts ) {
            for my $ext ( @{$exts} ) {
                push( @{$types{$ext}}, $type );
            }
        }
    }
    # add manually Makefile extensions
    push @{$types{$_}}, 'make' for qw{ mk mak };

    # These have to be checked before any filehandle diddling.
    $output_to_pipe  = not -t *STDOUT;
    $input_from_pipe = -p STDIN;

    $is_cygwin       = ($^O eq 'cygwin');
    $is_windows      = ($^O =~ /MSWin32/);
    $dir_sep_chars   = $is_windows ? quotemeta( '\\/' ) : quotemeta( File::Spec->catfile( '', '' ) );
}

sub read_ackrc {
    my @files = ( $ENV{ACKRC} );
    my @dirs =
        $is_windows
            ? ( $ENV{HOME}, $ENV{USERPROFILE} )
            : ( '~', $ENV{HOME} );
    for my $dir ( grep { defined } @dirs ) {
        for my $file ( '.ackrc', '_ackrc' ) {
            push( @files, bsd_glob( "$dir/$file", GLOB_TILDE ) );
        }
    }
    for my $filename ( @files ) {
        if ( defined $filename && -e $filename ) {
            open( my $fh, '<', $filename ) or App::Ack::die( "$filename: $!\n" );
            my @lines = grep { /./ && !/^\s*#/ } <$fh>;
            chomp @lines;
            close $fh or App::Ack::die( "$filename: $!\n" );

            # get rid of leading and trailing whitespaces
            for ( @lines ) {
               s/^\s+//;
               s/\s+$//;
            }

            return @lines;
        }
    }

    return;
}

sub get_command_line_options {
    my %opt = (
        pager => $ENV{ACK_PAGER_COLOR} || $ENV{ACK_PAGER},
    );

    my $getopt_specs = {
        1                       => sub { $opt{1} = $opt{m} = 1 },
        'A|after-context=i'     => \$opt{after_context},
        'B|before-context=i'    => \$opt{before_context},
        'C|context:i'           => sub { shift; my $val = shift; $opt{before_context} = $opt{after_context} = ($val || 2) },
        'a|all-types'           => \$opt{all},
        'break!'                => \$opt{break},
        c                       => \$opt{count},
        'color|colour!'         => \$opt{color},
        'color-match=s'         => \$ENV{ACK_COLOR_MATCH},
        'color-filename=s'      => \$ENV{ACK_COLOR_FILENAME},
        'color-lineno=s'        => \$ENV{ACK_COLOR_LINENO},
        'column!'               => \$opt{column},
        count                   => \$opt{count},
        'env!'                  => sub { }, # ignore this option, it is handled beforehand
        f                       => \$opt{f},
        flush                   => \$opt{flush},
        'follow!'               => \$opt{follow},
        'g=s'                   => sub { shift; $opt{G} = shift; $opt{f} = 1 },
        'G=s'                   => \$opt{G},
        'group!'                => sub { shift; $opt{heading} = $opt{break} = shift },
        'heading!'              => \$opt{heading},
        'h|no-filename'         => \$opt{h},
        'H|with-filename'       => \$opt{H},
        'i|ignore-case'         => \$opt{i},
        'invert-file-match'     => \$opt{invert_file_match},
        'lines=s'               => sub { shift; my $val = shift; push @{$opt{lines}}, $val },
        'l|files-with-matches'  => \$opt{l},
        'L|files-without-matches' => sub { $opt{l} = $opt{v} = 1 },
        'm|max-count=i'         => \$opt{m},
        'match=s'               => \$opt{regex},
        'n|no-recurse'          => \$opt{n},
        o                       => sub { $opt{output} = '$&' },
        'output=s'              => \$opt{output},
        'pager=s'               => \$opt{pager},
        'nopager'               => sub { $opt{pager} = undef },
        'passthru'              => \$opt{passthru},
        'print0'                => \$opt{print0},
        'Q|literal'             => \$opt{Q},
        'r|R|recurse'           => sub { $opt{n} = 0 },
        'show-types'            => \$opt{show_types},
        'smart-case!'           => \$opt{smart_case},
        'sort-files'            => \$opt{sort_files},
        'u|unrestricted'        => \$opt{u},
        'v|invert-match'        => \$opt{v},
        'w|word-regexp'         => \$opt{w},

        'ignore-dirs=s'         => sub { shift; my $dir = remove_dir_sep( shift ); $ignore_dirs{$dir} = '--ignore-dirs' },
        'noignore-dirs=s'       => sub { shift; my $dir = remove_dir_sep( shift ); delete $ignore_dirs{$dir} },

        'version'   => sub { print_version_statement(); exit; },
        'help|?:s'  => sub { shift; show_help(@_); exit; },
        'help-types'=> sub { show_help_types(); exit; },
        'man'       => sub {
            require Pod::Usage;
            Pod::Usage::pod2usage({
                -verbose => 2,
                -exitval => 0,
            });
        },

        'type=s'    => sub {
            # Whatever --type=xxx they specify, set it manually in the hash
            my $dummy = shift;
            my $type = shift;
            my $wanted = ($type =~ s/^no//) ? 0 : 1; # must not be undef later

            if ( exists $type_wanted{ $type } ) {
                $type_wanted{ $type } = $wanted;
            }
            else {
                App::Ack::die( qq{Unknown --type "$type"} );
            }
        }, # type sub
    };

    # Stick any default switches at the beginning, so they can be overridden
    # by the command line switches.
    unshift @ARGV, split( ' ', $ENV{ACK_OPTIONS} ) if defined $ENV{ACK_OPTIONS};

    # first pass through options, looking for type definitions
    def_types_from_ARGV();

    for my $i ( filetypes_supported() ) {
        $getopt_specs->{ "$i!" } = \$type_wanted{ $i };
    }


    my $parser = Getopt::Long::Parser->new();
    $parser->configure( 'bundling', 'no_ignore_case', );
    $parser->getoptions( %{$getopt_specs} ) or
        App::Ack::die( 'See ack --help, ack --help-types or ack --man for options.' );

    my $to_screen = not output_to_pipe();
    my %defaults = (
        all            => 0,
        color          => $to_screen,
        follow         => 0,
        break          => $to_screen,
        heading        => $to_screen,
        before_context => 0,
        after_context  => 0,
    );
    if ( $is_windows && $defaults{color} && not $ENV{ACK_PAGER_COLOR} ) {
        if ( $ENV{ACK_PAGER} || not eval { require Win32::Console::ANSI } ) {
            $defaults{color} = 0;
        }
    }
    if ( $to_screen && $ENV{ACK_PAGER_COLOR} ) {
        $defaults{color} = 1;
    }

    while ( my ($key,$value) = each %defaults ) {
        if ( not defined $opt{$key} ) {
            $opt{$key} = $value;
        }
    }

    if ( defined $opt{m} && $opt{m} <= 0 ) {
        App::Ack::die( '-m must be greater than zero' );
    }

    for ( qw( before_context after_context ) ) {
        if ( defined $opt{$_} && $opt{$_} < 0 ) {
            App::Ack::die( "--$_ may not be negative" );
        }
    }

    if ( defined( my $val = $opt{output} ) ) {
        $opt{output} = eval qq[ sub { "$val" } ];
    }
    if ( defined( my $l = $opt{lines} ) ) {
        # --line=1 --line=5 is equivalent to --line=1,5
        my @lines = split( /,/, join( ',', @{$l} ) );

        # --line=1-3 is equivalent to --line=1,2,3
        @lines = map {
            my @ret;
            if ( /-/ ) {
                my ($from, $to) = split /-/, $_;
                if ( $from > $to ) {
                    App::Ack::warn( "ignoring --line=$from-$to" );
                    @ret = ();
                }
                else {
                    @ret = ( $from .. $to );
                }
            }
            else {
                @ret = ( $_ );
            };
            @ret
        } @lines;

        if ( @lines ) {
            my %uniq;
            @uniq{ @lines } = ();
            $opt{lines} = [ sort { $a <=> $b } keys %uniq ];   # numerical sort and each line occurs only once!
        }
        else {
            # happens if there are only ignored --line directives
            App::Ack::die( 'All --line options are invalid.' );
        }
    }

    return \%opt;
}

sub def_types_from_ARGV {
    my @typedef;

    my $parser = Getopt::Long::Parser->new();
        # pass_through   => leave unrecognized command line arguments alone
        # no_auto_abbrev => otherwise -c is expanded and not left alone
    $parser->configure( 'no_ignore_case', 'pass_through', 'no_auto_abbrev' );
    $parser->getoptions(
        'type-set=s' => sub { shift; push @typedef, ['c', shift] },
        'type-add=s' => sub { shift; push @typedef, ['a', shift] },
    ) or App::Ack::die( 'See ack --help or ack --man for options.' );

    for my $td (@typedef) {
        my ($type, $ext) = split /=/, $td->[1];

        if ( $td->[0] eq 'c' ) {
            # type-set
            if ( exists $mappings{$type} ) {
                # can't redefine types 'make', 'skipped', 'text' and 'binary'
                App::Ack::die( qq{--type-set: Builtin type "$type" cannot be changed.} )
                    if ref $mappings{$type} ne 'ARRAY';

                delete_type($type);
            }
        }
        else {
            # type-add

            # can't append to types 'make', 'skipped', 'text' and 'binary'
            App::Ack::die( qq{--type-add: Builtin type "$type" cannot be changed.} )
                if exists $mappings{$type} && ref $mappings{$type} ne 'ARRAY';

            App::Ack::warn( qq{--type-add: Type "$type" does not exist, creating with "$ext" ...} )
                unless exists $mappings{$type};
        }

        my @exts = split /,/, $ext;
        s/^\.// for @exts;

        if ( !exists $mappings{$type} || ref($mappings{$type}) eq 'ARRAY' ) {
            push @{$mappings{$type}}, @exts;
            for my $e ( @exts ) {
                push @{$types{$e}}, $type;
            }
        }
        else {
            App::Ack::die( qq{Cannot append to type "$type".} );
        }
    }

    return;
}

sub delete_type {
    my $type = shift;

    App::Ack::die( qq{Internal error: Cannot delete builtin type "$type".} )
        unless ref $mappings{$type} eq 'ARRAY';

    delete $mappings{$type};
    delete $type_wanted{$type};
    for my $ext ( keys %types ) {
        $types{$ext} = [ grep { $_ ne $type } @{$types{$ext}} ];
    }
}

sub ignoredir_filter {
    return !exists $ignore_dirs{$_} && !exists $ignore_dirs{$File::Next::dir};
}

sub remove_dir_sep {
    my $path = shift;
    $path =~ s/[$dir_sep_chars]$//;

    return $path;
}

use constant TEXT => 'text';

sub filetypes {
    my $filename = shift;

    my $basename = $filename;
    $basename =~ s{.*[$dir_sep_chars]}{};

    return 'skipped' unless is_searchable( $basename );

    my $lc_basename = lc $basename;
    return ('make',TEXT)        if $lc_basename eq 'makefile' || $lc_basename eq 'gnumakefile';
    return ('rake','ruby',TEXT) if $lc_basename eq 'rakefile';

    # If there's an extension, look it up
    if ( $filename =~ m{\.([^\.$dir_sep_chars]+)$}o ) {
        my $ref = $types{lc $1};
        return (@{$ref},TEXT) if $ref;
    }

    # At this point, we can't tell from just the name.  Now we have to
    # open it and look inside.

    return unless -e $filename;
    # From Elliot Shank:
    #     I can't see any reason that -r would fail on these-- the ACLs look
    #     fine, and no program has any of them open, so the busted Windows
    #     file locking model isn't getting in there.  If I comment the if
    #     statement out, everything works fine
    # So, for cygwin, don't bother trying to check for readability.
    if ( !$is_cygwin ) {
        if ( !-r $filename ) {
            App::Ack::warn( "$filename: Permission denied" );
            return;
        }
    }

    return 'binary' if -B $filename;

    # If there's no extension, or we don't recognize it, check the shebang line
    my $fh;
    if ( !open( $fh, '<', $filename ) ) {
        App::Ack::warn( "$filename: $!" );
        return;
    }
    my $header = <$fh>;
    close $fh;

    if ( $header =~ /^#!/ ) {
        return ($1,TEXT)       if $header =~ /\b(ruby|p(?:erl|hp|ython))\b/;
        return ('shell',TEXT)  if $header =~ /\b(?:ba|t?c|k|z)?sh\b/;
    }
    else {
        return ('xml',TEXT)    if $header =~ /\Q<?xml /i;
    }

    return (TEXT);
}

sub is_searchable {
    my $filename = shift;

    # If these are updated, update the --help message
    return if $filename =~ /[.]bak$/;
    return if $filename =~ /~$/;
    return if $filename =~ m{^#.*#$}o;
    return if $filename =~ m{^core\.\d+$}o;
    return if $filename =~ m{[._].*\.swp$}o;

    return 1;
}

sub build_regex {
    my $str = shift;
    my $opt = shift;

    defined $str or App::Ack::die( 'No regular expression found.' );

    $str = quotemeta( $str ) if $opt->{Q};
    if ( $opt->{w} ) {
        $str = "\\b$str" if $str =~ /^\w/;
        $str = "$str\\b" if $str =~ /\w$/;
    }

    my $regex_is_lc = $str eq lc $str;
    if ( $opt->{i} || ($opt->{smart_case} && $regex_is_lc) ) {
        $str = "(?i)$str";
    }

    return $str;
}

sub check_regex {
    my $regex = shift;

    return unless defined $regex;

    eval { qr/$regex/ };
    if ($@) {
        (my $error = $@) =~ s/ at \S+ line \d+.*//;
        chomp($error);
        App::Ack::die( "Invalid regex '$regex':\n  $error" );
    }

    return;
}

sub warn { ## no critic (ProhibitBuiltinHomonyms)
    return CORE::warn( _my_program(), ': ', @_, "\n" );
}

sub die { ## no critic (ProhibitBuiltinHomonyms)
    return CORE::die( _my_program(), ': ', @_, "\n" );
}

sub _my_program {
    require File::Basename;
    return File::Basename::basename( $0 );
}

sub filetypes_supported {
    return keys %mappings;
}

sub _get_thpppt {
    my $y = q{_   /|,\\'!.x',=(www)=,   U   };
    $y =~ tr/,x!w/\nOo_/;
    return $y;
}

sub _thpppt {
    my $y = _get_thpppt();
    App::Ack::print( "$y ack $_[0]!\n" );
    exit 0;
}

sub _key {
    my $str = lc shift;
    $str =~ s/[^a-z]//g;

    return $str;
}

sub show_help {
    my $help_arg = shift || 0;

    return show_help_types() if $help_arg =~ /^types?/;

    my $ignore_dirs = _listify( sort { _key($a) cmp _key($b) } keys %ignore_dirs );

    App::Ack::print( <<"END_OF_HELP" );
Usage: ack [OPTION]... PATTERN [FILE]

Search for PATTERN in each source file in the tree from cwd on down.
If [FILES] is specified, then only those files/directories are checked.
ack may also search STDIN, but only if no FILE are specified, or if
one of FILES is "-".

Default switches may be specified in ACK_OPTIONS environment variable or
an .ackrc file. If you want no dependency on the environment, turn it
off with --noenv.

Example: ack -i select

Searching:
  -i, --ignore-case     Ignore case distinctions in PATTERN
  --[no]smart-case      Ignore case distinctions in PATTERN,
                        only if PATTERN contains no upper case
                        Ignored if -i is specified
  -v, --invert-match    Invert match: select non-matching lines
  -w, --word-regexp     Force PATTERN to match only whole words
  -Q, --literal         Quote all metacharacters; PATTERN is literal

Search output:
  --line=NUM            Only print line(s) NUM of each file
  -l, --files-with-matches
                        Only print filenames containing matches
  -L, --files-without-matches
                        Only print filenames with no matches
  -o                    Show only the part of a line matching PATTERN
                        (turns off text highlighting)
  --passthru            Print all lines, whether matching or not
  --output=expr         Output the evaluation of expr for each line
                        (turns off text highlighting)
  --match PATTERN       Specify PATTERN explicitly.
  -m, --max-count=NUM   Stop searching in each file after NUM matches
  -1                    Stop searching after one match of any kind
  -H, --with-filename   Print the filename for each match
  -h, --no-filename     Suppress the prefixing filename on output
  -c, --count           Show number of lines matching per file
  --column              Show the column number of the first match

  -A NUM, --after-context=NUM
                        Print NUM lines of trailing context after matching
                        lines.
  -B NUM, --before-context=NUM
                        Print NUM lines of leading context before matching
                        lines.
  -C [NUM], --context[=NUM]
                        Print NUM lines (default 2) of output context.

  --print0              Print null byte as separator between filenames,
                        only works with -f, -g, -l, -L or -c.

File presentation:
  --pager=COMMAND       Pipes all ack output through COMMAND.  For example,
                        --pager="less -R".  Ignored if output is redirected.
  --nopager             Do not send output through a pager.  Cancels any
                        setting in ~/.ackrc, ACK_PAGER or ACK_PAGER_COLOR.
  --[no]heading         Print a filename heading above each file's results.
                        (default: on when used interactively)
  --[no]break           Print a break between results from different files.
                        (default: on when used interactively)
  --group               Same as --heading --break
  --nogroup             Same as --noheading --nobreak
  --[no]color           Highlight the matching text (default: on unless
                        output is redirected, or on Windows)
  --[no]colour          Same as --[no]color
  --color-filename=COLOR
  --color-match=COLOR
  --color-lineno=COLOR  Set the color for filenames, matches, and line numbers.
  --flush               Flush output immediately, even when ack is used
                        non-interactively (when output goes to a pipe or
                        file).

File finding:
  -f                    Only print the files found, without searching.
                        The PATTERN must not be specified.
  -g REGEX              Same as -f, but only print files matching REGEX.
  --sort-files          Sort the found files lexically.
  --invert-file-match   Print/search handle files that do not match -g/-G.
  --show-types          Show which types each file has.

File inclusion/exclusion:
  -a, --all-types       All file types searched;
                        Ignores CVS, .svn and other ignored directories
  -u, --unrestricted    All files and directories searched
  --[no]ignore-dir=name Add/Remove directory from the list of ignored dirs
  -r, -R, --recurse     Recurse into subdirectories (ack's default behavior)
  -n, --no-recurse      No descending into subdirectories
  -G REGEX              Only search files that match REGEX

  --perl                Include only Perl files.
  --type=perl           Include only Perl files.
  --noperl              Exclude Perl files.
  --type=noperl         Exclude Perl files.
                        See "ack --help type" for supported filetypes.

  --type-set TYPE=.EXTENSION[,.EXT2[,...]]
                        Files with the given EXTENSION(s) are recognized as
                        being of type TYPE. This replaces an existing
                        definition for type TYPE.
  --type-add TYPE=.EXTENSION[,.EXT2[,...]]
                        Files with the given EXTENSION(s) are recognized as
                        being of (the existing) type TYPE

  --[no]follow          Follow symlinks.  Default is off.

  Directories ignored by default:
    $ignore_dirs

  Files not checked for type:
    /~\$/           - Unix backup files
    /#.+#\$/        - Emacs swap files
    /[._].*\\.swp\$/ - Vi(m) swap files
    /core\\.\\d+\$/   - core dumps

Miscellaneous:
  --noenv               Ignore environment variables and ~/.ackrc
  --help                This help
  --man                 Man page
  --version             Display version & copyright
  --thpppt              Bill the Cat

Exit status is 0 if match, 1 if no match.

This is version $VERSION of ack.
END_OF_HELP

    return;
 }

sub show_help_types {
    App::Ack::print( <<'END_OF_HELP' );
Usage: ack [OPTION]... PATTERN [FILES]

The following is the list of filetypes supported by ack.  You can
specify a file type with the --type=TYPE format, or the --TYPE
format.  For example, both --type=perl and --perl work.

Note that some extensions may appear in multiple types.  For example,
.pod files are both Perl and Parrot.

END_OF_HELP

    my @types = filetypes_supported();
    my $maxlen = 0;
    for ( @types ) {
        $maxlen = length if $maxlen < length;
    }
    for my $type ( sort @types ) {
        next if $type =~ /^-/; # Stuff to not show
        my $ext_list = $mappings{$type};

        if ( ref $ext_list ) {
            $ext_list = join( ' ', map { ".$_" } @{$ext_list} );
        }
        App::Ack::print( sprintf( "    --[no]%-*.*s %s\n", $maxlen, $maxlen, $type, $ext_list ) );
    }

    return;
}

sub _listify {
    my @whats = @_;

    return '' if !@whats;

    my $end = pop @whats;
    my $str = @whats ? join( ', ', @whats ) . " and $end" : $end;

    no warnings 'once';
    require Text::Wrap;
    $Text::Wrap::columns = 75;
    return Text::Wrap::wrap( '', '    ', $str );
}

sub get_version_statement {
    require Config;

    my $copyright = get_copyright();
    my $this_perl = $Config::Config{perlpath};
    if ($^O ne 'VMS') {
        my $ext = $Config::Config{_exe};
        $this_perl .= $ext unless $this_perl =~ m/$ext$/i;
    }
    my $ver = sprintf( '%vd', $^V );

    return <<"END_OF_VERSION";
ack $VERSION
Running under Perl $ver at $this_perl

$copyright

This program is free software.  You may modify or distribute it
under the terms of the Artistic License v2.0.
END_OF_VERSION
}

sub print_version_statement {
    App::Ack::print( get_version_statement() );

    return;
}

sub get_copyright {
    return $COPYRIGHT;
}

sub load_colors {
    eval 'use Term::ANSIColor ()';

    $ENV{ACK_COLOR_MATCH}    ||= 'black on_yellow';
    $ENV{ACK_COLOR_FILENAME} ||= 'bold green';
    $ENV{ACK_COLOR_LINENO}   ||= 'bold yellow';

    return;
}

sub is_interesting {
    return if /^\./;

    my $include;

    for my $type ( filetypes( $File::Next::name ) ) {
        if ( defined $type_wanted{$type} ) {
            if ( $type_wanted{$type} ) {
                $include = 1;
            }
            else {
                return;
            }
        }
    }

    return $include;
}



# print subs added in order to make it easy for a third party
# module (such as App::Wack) to redefine the display methods
# and show the results in a different way.
sub print                   { print {$fh} @_ }
sub print_first_filename    { App::Ack::print( $_[0], "\n" ) }
sub print_blank_line        { App::Ack::print( "\n" ) }
sub print_separator         { App::Ack::print( "--\n" ) }
sub print_filename          { App::Ack::print( $_[0], $_[1] ) }
sub print_line_no           { App::Ack::print( $_[0], $_[1] ) }
sub print_column_no         { App::Ack::print( $_[0], $_[1] ) }
sub print_count {
    my $filename = shift;
    my $nmatches = shift;
    my $ors = shift;
    my $count = shift;
    my $show_filename = shift;

    if ($show_filename) {
        App::Ack::print( $filename );
        App::Ack::print( ':', $nmatches ) if $count;
    }
    else {
        App::Ack::print( $nmatches ) if $count;
    }
    App::Ack::print( $ors );
}

sub print_count0 {
    my $filename = shift;
    my $ors = shift;
    my $show_filename = shift;

    if ($show_filename) {
        App::Ack::print( $filename, ':0', $ors );
    }
    else {
        App::Ack::print( '0', $ors );
    }
}

{
    my $filename;
    my $regex;
    my $display_filename;

    my $keep_context;

    my $last_output_line;             # number of the last line that has been output
    my $any_output;                   # has there been any output for the current file yet
    my $context_overall_output_count; # has there been any output at all

sub search_resource {
    my $res = shift;
    my $opt = shift;

    $filename = $res->name();

    my $v = $opt->{v};
    my $passthru = $opt->{passthru};
    my $max = $opt->{m};
    my $nmatches = 0;

    $display_filename = undef;

    # for --line processing
    my $has_lines = 0;
    my @lines;
    if ( defined $opt->{lines} ) {
        $has_lines = 1;
        @lines = ( @{$opt->{lines}}, -1 );
        undef $regex; # Don't match when printing matching line
    }
    else {
        $regex = qr/$opt->{regex}/;
    }

    # for context processing
    $last_output_line = -1;
    $any_output = 0;
    my $before_context = $opt->{before_context};
    my $after_context  = $opt->{after_context};

    $keep_context = ($before_context || $after_context) && !$passthru;

    my @before;
    my $before_starts_at_line;
    my $after = 0; # number of lines still to print after a match

    while ( $res->next_text ) {
        # XXX Optimize away the case when there are no more @lines to find.
        # XXX $has_lines, $passthru and $v never change.  Optimize.
        if ( $has_lines
               ? $. != $lines[0]  # $lines[0] should be a scalar
               : $v ? m/$regex/ : !m/$regex/ ) {
            if ( $passthru ) {
                App::Ack::print( $_ );
                next;
            }

            if ( $keep_context ) {
                if ( $after ) {
                    print_match_or_context( $opt, 0, $., $-[0], $+[0], $_ );
                    $after--;
                }
                elsif ( $before_context ) {
                    if ( @before ) {
                        if ( @before >= $before_context ) {
                            shift @before;
                            ++$before_starts_at_line;
                        }
                    }
                    else {
                        $before_starts_at_line = $.;
                    }
                    push @before, $_;
                }
                last if $max && ( $nmatches >= $max ) && !$after;
            }
            next;
        } # not a match

        ++$nmatches;

        # print an empty line as a divider before first line in each file (not before the first file)
        if ( !$any_output && $opt->{show_filename} && $opt->{break} && defined( $context_overall_output_count ) ) {
            App::Ack::print_blank_line();
        }

        shift @lines if $has_lines;

        if ( $res->is_binary ) {
            App::Ack::print( "Binary file $filename matches\n" );
            last;
        }
        if ( $keep_context ) {
            if ( @before ) {
                print_match_or_context( $opt, 0, $before_starts_at_line, $-[0], $+[0], @before );
                @before = ();
                $before_starts_at_line = 0;
            }
            if ( $max && $nmatches > $max ) {
                --$after;
            }
            else {
                $after = $after_context;
            }
        }
        print_match_or_context( $opt, 1, $., $-[0], $+[0], $_ );

        last if $max && ( $nmatches >= $max ) && !$after;
    } # while

    return $nmatches;
}   # search_resource()

sub print_match_or_context {
    my $opt         = shift; # opts array
    my $is_match    = shift; # is there a match on the line?
    my $line_no     = shift;
    my $match_start = shift;
    my $match_end   = shift;

    my $color         = $opt->{color};
    my $heading       = $opt->{heading};
    my $show_filename = $opt->{show_filename};
    my $show_column   = $opt->{column};

    if ( $show_filename ) {
        if ( not defined $display_filename ) {
            $display_filename =
                $color
                    ? Term::ANSIColor::colored( $filename, $ENV{ACK_COLOR_FILENAME} )
                    : $filename;
            if ( $heading && !$any_output ) {
                App::Ack::print_first_filename($display_filename);
            }
        }
    }

    my $sep = $is_match ? ':' : '-';
    my $output_func = $opt->{output};
    for ( @_ ) {
        if ( $keep_context && !$output_func ) {
            if ( ( $last_output_line != $line_no - 1 ) &&
                ( $any_output || ( !$heading && defined( $context_overall_output_count ) ) ) ) {
                App::Ack::print_separator();
            }
            # to ensure separators between different files when --noheading

            $last_output_line = $line_no;
        }

        if ( $show_filename ) {
            App::Ack::print_filename($display_filename, $sep) if not $heading;
            my $display_line_no =
                $color
                    ? Term::ANSIColor::colored( $line_no, $ENV{ACK_COLOR_LINENO} )
                    : $line_no;
            App::Ack::print_line_no($display_line_no, $sep);
        }

        if ( $output_func ) {
            while ( /$regex/go ) {
                App::Ack::print( $output_func->() . "\n" );
            }
        }
        else {
            if ( $color && $is_match && $regex &&
                 s/$regex/Term::ANSIColor::colored( substr($_, $-[0], $+[0] - $-[0]), $ENV{ACK_COLOR_MATCH} )/eg ) {
                # At the end of the line reset the color and remove newline
                s/[\r\n]*\z/\e[0m\e[K/;
            }
            else {
                # remove any kind of newline at the end of the line
                s/[\r\n]*\z//;
            }
            if ( $show_column ) {
                App::Ack::print_column_no( $match_start+1, $sep );
            }
            App::Ack::print($_ . "\n");
        }
        $any_output = 1;
        ++$context_overall_output_count;
        ++$line_no;
    }

    return;
} # print_match_or_context()

} # scope around search_resource() and print_match_or_context()


TOTAL_COUNT_SCOPE: {
my $total_count;

sub get_total_count {
    return $total_count;
}

sub reset_total_count {
    $total_count = 0;
}

sub search_and_list {
    my $res = shift;
    my $opt = shift;

    my $nmatches = 0;
    my $count = $opt->{count};
    my $ors = $opt->{print0} ? "\0" : "\n"; # output record separator
    my $show_filename = $opt->{show_filename};

    my $regex = qr/$opt->{regex}/;

    if ( $opt->{v} ) {
        while ( $res->next_text ) {
            if ( /$regex/ ) {
                return 0 unless $count;
            }
            else {
                ++$nmatches;
            }
        }
    }
    else {
        while ( $res->next_text ) {
            if ( /$regex/ ) {
                ++$nmatches;
                last unless $count;
            }
        }
    }

    if ( $opt->{show_total} ) {
        $total_count += $nmatches;
    }
    else {
        if ( $nmatches ) {
            App::Ack::print_count( $res->name, $nmatches, $ors, $count, $show_filename );
        }
        elsif ( $count && !$opt->{l} ) {
            App::Ack::print_count0( $res->name, $ors, $show_filename );
        }
    }

    return $nmatches ? 1 : 0;
}   # search_and_list()

} # scope around $total_count

sub filetypes_supported_set {
    return grep { defined $type_wanted{$_} && ($type_wanted{$_} == 1) } filetypes_supported();
}

sub print_files {
    my $iter = shift;
    my $opt = shift;

    my $ors = $opt->{print0} ? "\0" : "\n";

    my $nmatches = 0;
    while ( defined ( my $file = $iter->() ) ) {
        App::Ack::print $file, $opt->{show_types} ? " => " . join( ',', filetypes( $file ) ) : (),  $ors;
        $nmatches++;
        last if $opt->{1};
    }

    return $nmatches;
}

sub print_files_with_matches {
    my $iter = shift;
    my $opt = shift;

    # if we have -l and only 1 file given on command line (this means
    # show_filename is set to 0), we want to see the filename nevertheless
    $opt->{show_filename} = 1 if $opt->{l};

    $opt->{show_filename} = 0 if $opt->{h};
    $opt->{show_filename} = 1 if $opt->{H};

    # abuse options to hand in the show_total parameter to search_and_list
    $opt->{show_total} = $opt->{count} && !$opt->{show_filename};
    reset_total_count();

    my $nmatches = 0;
    while ( defined ( my $filename = $iter->() ) ) {
        my $repo = App::Ack::Repository::Basic->new( $filename );
        my $res;
        while ( $res = $repo->next_resource() ) {
            $nmatches += search_and_list( $res, $opt );
            $res->close();
            last if $nmatches && $opt->{1};
        }
        $repo->close();
    }

    if ( $nmatches && $opt->{show_total} ) {
        App::Ack::print_count('', get_total_count(), "\n", 1, 0  )
    }

    return $nmatches;
}

sub print_matches {
    my $iter = shift;
    my $opt = shift;

    $opt->{show_filename} = 0 if $opt->{h};
    $opt->{show_filename} = 1 if $opt->{H};

    my $nmatches = 0;
    while ( defined ( my $filename = $iter->() ) ) {
        my $repo;
        my $tarballs_work = 0;
        if ( $tarballs_work && $filename =~ /\.tar\.gz$/ ) {
            App::Ack::die( 'Not working here yet' );
            require App::Ack::Repository::Tar; # XXX Error checking
            $repo = App::Ack::Repository::Tar->new( $filename );
        }
        else {
            $repo = App::Ack::Repository::Basic->new( $filename );
        }
        $repo or next;

        while ( my $res = $repo->next_resource() ) {
            my $needs_line_scan;
            if ( $opt->{regex} && !$opt->{passthru} ) {
                $needs_line_scan = $res->needs_line_scan( $opt );
                if ( $needs_line_scan ) {
                    $res->reset();
                }
            }
            else {
                $needs_line_scan = 1;
            }
            if ( $needs_line_scan ) {
                $nmatches += search_resource( $res, $opt );
            }
            $res->close();
        }
        last if $nmatches && $opt->{1};
        $repo->close();
    }
    return  $nmatches;
}

sub filetype_setup {
    my $filetypes_supported_set = filetypes_supported_set();
    # If anyone says --no-whatever, we assume all other types must be on.
    if ( !$filetypes_supported_set ) {
        for my $i ( keys %type_wanted ) {
            $type_wanted{$i} = 1 unless ( defined( $type_wanted{$i} ) || $i eq 'binary' || $i eq 'text' || $i eq 'skipped' );
        }
    }
    return;
}

EXPAND_FILENAMES_SCOPE: {
    my $filter;

    sub expand_filenames {
        my $argv = shift;

        my $attr;
        my @files;

        foreach my $pattern ( @{$argv} ) {
            my @results = bsd_glob( $pattern );

            if (@results == 0) {
                @results = $pattern; # Glob didn't match, pass it thru unchanged
            }
            elsif ( (@results > 1) or ($results[0] ne $pattern) ) {
                if (not defined $filter) {
                    eval 'require Win32::File;';
                    if ($@) {
                        $filter = 0;
                    }
                    else {
                        $filter = Win32::File::HIDDEN()|Win32::File::SYSTEM();
                    }
                } # end unless we've tried to load Win32::File
                if ( $filter ) {
                    # Filter out hidden and system files:
                    @results = grep { not(Win32::File::GetAttributes($_, $attr) and $attr & $filter) } @results;
                    App::Ack::warn( "$pattern: Matched only hidden files" ) unless @results;
                } # end if we can filter by file attributes
            } # end elsif this pattern got expanded

            push @files, @results;
        } # end foreach pattern

        return \@files;
    } # end expand_filenames
} # EXPAND_FILENAMES_SCOPE

sub get_starting_points {
    my $argv = shift;
    my $opt = shift;

    my @what;

    if ( @{$argv} ) {
        @what = @{ $is_windows ? expand_filenames($argv) : $argv };
        $_ = File::Next::reslash( $_ ) for @what;

        # Show filenames unless we've specified one single file
        $opt->{show_filename} = (@what > 1) || (!-f $what[0]);
    }
    else {
        @what = '.'; # Assume current directory
        $opt->{show_filename} = 1;
    }

    for my $start_point (@what) {
        App::Ack::warn( "$start_point: No such file or directory" ) unless -e $start_point;
    }
    return \@what;
}

sub _match {
    my ( $target, $expression, $invert_flag ) = @_;

    if ( $invert_flag ) {
        return $target !~ $expression;
    }
    else {
        return $target =~ $expression;
    }
}

sub get_iterator {
    my $what = shift;
    my $opt  = shift;

    # Starting points are always searched, no matter what
    my %starting_point = map { ($_ => 1) } @{$what};

    my $g_regex = defined $opt->{G} ? qr/$opt->{G}/ : undef;
    my $file_filter;

    if ( $g_regex ) {
        $file_filter
            = $opt->{u}   ? sub { _match( $File::Next::name, qr/$g_regex/, $opt->{invert_file_match} ) }    # XXX Maybe this should be a 1, no?
            : $opt->{all} ? sub { $starting_point{ $File::Next::name } || ( _match( $File::Next::name, qr/$g_regex/, $opt->{invert_file_match} ) && is_searchable( $_ ) ) }
            :               sub { $starting_point{ $File::Next::name } || ( _match( $File::Next::name, qr/$g_regex/, $opt->{invert_file_match} ) && is_interesting( @ _) ) }
            ;
    }
    else {
        $file_filter
            = $opt->{u}   ? sub {1}
            : $opt->{all} ? sub { $starting_point{ $File::Next::name } || is_searchable( $_ ) }
            :               sub { $starting_point{ $File::Next::name } || is_interesting( @_ ) }
            ;
    }

    my $descend_filter
        = $opt->{n} ? sub {0}
        : $opt->{u} ? sub {1}
        : \&ignoredir_filter;

    my $iter =
        File::Next::files( {
            file_filter     => $file_filter,
            descend_filter  => $descend_filter,
            error_handler   => sub { my $msg = shift; App::Ack::warn( $msg ) },
            sort_files      => $opt->{sort_files},
            follow_symlinks => $opt->{follow},
        }, @{$what} );
    return $iter;
}


sub set_up_pager {
    my $command = shift;

    return if App::Ack::output_to_pipe();

    my $pager;
    if ( not open( $pager, '|-', $command ) ) {
        App::Ack::die( qq{Unable to pipe to pager "$command": $!} );
    }
    $fh = $pager;

    return;
}

sub input_from_pipe {
    return $input_from_pipe;
}

sub output_to_pipe {
    return $output_to_pipe;
}

sub exit_from_ack {
    my $nmatches = shift;

    my $rc = $nmatches ? 0 : 1;
    exit $rc;
}

1; # End of App::Ack