#!/usr/bin/perl

# Created on: 2009-08-07 18:33:36
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use strict;
use warnings;
use version;
use Carp qw/carp croak confess cluck/;
use Getopt::Long;
use Pod::Usage;
use List::Util qw/sum/;
use List::MoreUtils qw/uniq/;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use FindBin qw/$Bin/;
use Term::ANSIColor qw/:constants/;
use Path::Class;
use File::Copy;
use File::CodeSearch;
use File::CodeSearch::Replacer;
use File::CodeSearch::Files;
use Config::General;
use IO::Prompt qw/prompt/;

our $VERSION = version->new('0.5.0');
my ($name)   = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
my $REVERSE  = REVERSE;
my $RESET    = RESET;
my $BLUE     = BLUE;
my $BOLD     = BOLD;
my $ON_RED   = ON_RED;
my $ON_GREEN = ON_GREEN;

my %option = (
	verbose => 0,
	man     => 0,
	help    => 0,
	VERSION => 0,
);

if ( !@ARGV ) {
	pod2usage( -verbose => 1 );
}

main();
exit 0;

sub main {

	Getopt::Long::Configure('bundling');
	GetOptions(
		\%option,
		'sre_all|all|A',
		'sre_words|words|W',
		'sre_ignore_case|ignore|i',
		'sre_whole|whole|w',
		'sre_sub_matches|contains|c=s@',
		'sre_sub_no_matches|not-contains|notcontains|S=s@',
		'sre_last|last|L=s@',
		'sre_smart|smart|m',
		'replace|r=s',
		'path|p=s@',
		'file_symlinks|links|l',
		'file_recurse|R!',
		'file_contains=s',
		'file_not_contains=s',
		'file_include|include|n=s@',
		'file_include_type|include_type|int|N=s@',
		'file_exclude|exclude|x=s@',
		'file_exclude_type|exclude_type|ext|X=s@',
		'file_ignore=s',
		'file_ignore_add|d=s',
		'file_ignore_remove|I=s',
		'out_suround|suround|s=n',
		'out_suround_before|before|b=n',
		'out_suround_after|after|a=n',
		'out_totals|totals|t',
		'out_files_only|files-only|f',
		'out_unique|unique|u!',
		'out_limit|limit=i',
		'project|P=s',
		'execute|execute-files|E=s',
		'config|C=s',
		'bw|g',
		'verbose|v+',
		'man',
		'help',
		'VERSION!',
	) or pod2usage(2);

	if ( $option{'VERSION'} ) {
		print "$name Version = $VERSION\n";
		exit 1;
	}
	elsif ( $option{'man'} ) {
		pod2usage( -verbose => 2 );
	}
	elsif ( $option{'help'} ) {
		pod2usage( -verbose => 1 );
	}

	# do stuff here

	$option{path} = $option{path} ? [ map {split /:/, $_} @{$option{path}} ] : ['.'];

	if ($option{out_suround}) {
		$option{out_suround_before} ||= $option{out_suround};
		$option{out_suround_after}  ||= $option{out_suround};
		delete $option{out_suround};
	}

	parse_config(\%option);

	my $lines = 80;
	if ($option{sre_smart}) {
		($lines) = split /\s+/, `stty size` || 40;
		if (( !$option{file_include_type} || !@{ $option{file_include_type} }) && grep {$_ eq $ARGV[0]} qw/n b ss/) {
			$option{file_include_type}[0] = 'programing';
		}
	}

	warn Dumper { params('file', %option) } if $option{verbose};
	my $files = File::CodeSearch::Files->new(params('file', %option));

	warn Dumper { params('sre', %option), re => \@ARGV } if $option{verbose};
	my $hl =
		$option{replace} ? File::CodeSearch::Replacer->new( params('sre', %option), re => \@ARGV, replace => $option{replace} )
		:                  File::CodeSearch::Highlighter->new( params('sre', %option), re => \@ARGV );

	if ($option{bw}) {
		$REVERSE = '';
		$RESET   = '';
		$BLUE    = '';
		$BOLD    = '';
		$ON_RED  = '';
		$hl->before_match('');
		$hl->after_match('');
		$hl->before_nomatch('');
		$hl->after_nomatch('');
	}
	warn Dumper {params('out',%option)}, \%option if $option{verbose};
	my $cs = File::CodeSearch->new( regex => $hl, files => $files, replace => !!$option{replace}, params('out',%option) );

	my $fh = \*STDOUT;
	my %match;
	my %found;
	my $out = '';
	if ( !$option{sre_smart} || $option{replace} ) {
		$option{bw} = 1;
	}
	$cs->search(
		searcher(\%found, \$out, \%match, $hl, $lines, $fh),
		@{ $option{path} }
	);
	if ($out) {
		if ($option{sre_smart}) {
			print $out;
		}
		else {
			print {$fh} $out;
		}
	}

	if ($option{out_unique}) {
		print join "\n", sort keys %match;
		print "\n";
	}
	if ($option{execute}) {
		system $option{execute} . ' ' . join ' ', sort keys %found;
	}
	if ($option{out_totals}) {
		print "\nTotal matches " . (sum values %found) . "\n";
	}

	return;
}

sub searcher {
	my ($found, $out, $match, $hl, $lines, $fh) = @_;
	my $last_file = undef;
	my $answer = {};
	my $content = '';

	return sub {
		my ($line, $file, $line_no, %stuff ) = @_;
		confess "No line number provided!\n" if !defined $line_no;
		my $saved = 0;

		if ( !$found->{$file} && !$option{out_unique} && !($option{out_files_only} && $option{out_totals}) ) {
			$$out .= "${file}\n";
		}
		$found->{$file}++;
		if (!defined $last_file || $file ne $last_file) {
			if ( defined $last_file ) {
				if ( $option{out_files_only} && $option{out_totals} ) {
					$$out .= "$last_file ($found->{$last_file})\n";
				}
			}
			$last_file = $file;
		}
		return if $option{out_files_only};

		# check if there were lines after the last match and display them
		if ( $stuff{after} && @{ $stuff{after} } ) {
			my @after = @{ $stuff{after} };
			my $count = $stuff{last_line_no} + 1;
			for my $after_line ( @after ) {
				last if $line && $line eq $after_line;
				$$out .= sprintf $REVERSE . '%4i: ' . $RESET . '%s', $count++, $after_line;
			}
		}
		# check if there were lines before this match and display them
		if ( $stuff{before} && @{ $stuff{before} } ) {
			my @before = @{ $stuff{before} };
			my $count = @before;
			for my $before_line ( @before ) {
				confess Dumper(\%stuff) . "Bad line" if !defined $before_line || !defined $count;
				$$out .= sprintf $REVERSE . '%4i: ' . $RESET . $before_line, $line_no - $count--;
			}
		}

		if ($option{out_unique}) {
			$match->{$hl->match($line)}++ if ($line);
		}
		elsif ($line) {
			my $last = $hl->get_last_found();
			if ($last) {
				$$out .= $BLUE . $last . $RESET;
			}

			my ( $found, $before, $after, $to ) = $hl->highlight($line);
			if ($found) {
				$$out .= sprintf $REVERSE . $BOLD . $ON_RED . '%4i: ' . $RESET . '%s', $line_no, $found;
			}
			elsif ($before) {
				my $ans = '';
				if ( $answer->{all} ) {
					$$out .= sprintf $REVERSE . $BOLD . $ON_GREEN . '%4i: ' . $RESET . '%s', $line_no, $after;
				}
				else {
					$$out .= sprintf $REVERSE . $BOLD . $ON_RED . 'From: ' . $RESET . '%s', $before;
					$$out .= sprintf $REVERSE . $BOLD . $ON_RED . 'To    ' . $RESET . '%s', $after;
					print {$fh} $$out;
					$$out = '';

					$ans = lc prompt(-prompt => $RESET . "Change? [yNa] ", -default => 'n', '-1t');
					print "\n";
				}

				if ( $ans eq 'a') {
					$answer->{all} = 1;
				}
				if ( $ans eq 'y' || $answer->{all} ) {
					$stuff{lines}[-1] = $to;
					$answer->{yes} = 1;
					#warn $changed;
				}
			}
		}

		if ( $stuff{lines} && @{ $stuff{lines} } ) {
			$content .= join '', @{ $stuff{lines} };
			@{ $stuff{lines} } = ();
		}

		if ( !$line && $out ) {
			save_replace( $last_file, $content, $answer );
			$content = '';
		}

		if ($option{bw}) {
			print {$fh} $$out;
			$$out = '';
		}
		if ( $$out && ( !$option{sre_smart} || (my @tmp = split /\n/, $$out) >= $lines) ) {
			if ($option{sre_smart}) {
				open my $tmp, '|-', 'less -R';
				$fh = $tmp || $fh;
			}
			print {$fh} $$out;
			$$out = '';
			$option{sre_smart} = 0;
		}

		return;
	};
}

sub save_replace {
	my ( $file, $content, $answer ) = @_;

	# check that we have something to do
	return if !$answer->{yes};

	delete $answer->{yes};

	my $ans = $answer->{save_all} ? 'y' : 'n';
	if ( !$answer->{save_all} ) {
		$ans = prompt "Save changes to $file? [yNa] ", -default => 'n', '-1t';
	}

	if ( $ans eq 'a' ) {
		$answer->{save_all} = 1;
	}
	if ( $ans eq 'y' || $answer->{save_all} ) {
		$file = file($file);
		my $backup = $file->parent->file($file->basename . '~');
		my $i = 1;
		while (-f $backup) {
			$backup = $file->parent->file($file->basename . '~' . $i);
		}
		move $file, $backup;
		my $fh = $file->openw;
		print {$fh} $content;
		close $fh;
		$content = '';
		print "Saved $file\n";
	}

	return;
}

sub params {
	my ($name, %var) = @_;
	my %params;

	VAR:
	for my $key (keys %var) {
		next VAR if $key !~ /^ $name _ /xms;
		my $new_key = $key;
		$new_key =~ s/^ $name _ //xms;
		$params{$new_key} = $var{$key};
	}

	return %params;
}

sub parse_config {
	my ($opt) = @_;

	my $conf_file = $opt->{config} || "$ENV{HOME}/.csrc";

	return if !-r $conf_file;

	my $conf = Config::General->new($conf_file);
	my %conf = $conf->getall();

	$conf{default} ||= {};
	$conf{project} ||= {};

	my $default = $conf{default};

	my $project =
		$opt->{project} ? $opt->{project}
		: $name ne 'cs' ? $name
		:                 undef;
	if ( $project && $conf{project} && keys %{$conf{project}} && $conf{project}{$project} ) {
		$default = merge($conf{project}{$project} || {}, $default);
	}

	%$opt = %{ merge($default, $opt) };

	return;
}

sub merge {
	my ($hash1, $hash2, @rest) = @_;
	my $merge = {};

	for my $key (uniq sort keys %{$hash1}, keys %{$hash2}) {
		$merge->{$key} =
			exists $hash1->{$key} ? $hash1->{$key}
		:                           $hash2->{$key};
	}

	return merge($merge, @rest) if @rest;

	return $merge;
}

__DATA__

=head1 NAME

cs - Search & replace text (with some intelligence)

=head1 VERSION

This documentation refers to cs version 0.5.0.

=head1 SYNOPSIS

   cs [option] search
   cr [option] search replace

 OPTIONS:
  Search:
   -A --all      Find all parts on regardless of order on the line
   -W --words
                 Similar to --all but with out the reordering
   -i --ignore-case
                 Turn off case sensitive searching
   -w --whole    Makes the match only whole words (ie wraps with (?<\W) & (?=\W))
   -c --contains=re
                 Only show matches if the file also matches this sub regex.
                 This may be declared more that once and the results are ORed.
   -S --not-contains=re
                 Ignore any files whoes contents match this regex.
   -m --smart    converts multi part regexes baised on what is imput
                 eg cs ss Class is converted to cs class Class
                    cs n func                   cs function func
                    cs b subroutine             cs sub subroutine
  Replace:
   -r --replace=string
                 String to replace found text with
  Files:
   -p --path=string
                 A colon seperated list of directories to search in
                 (Default current directory)
   -l --follow-symlinks
                 Follow symlinks to directories
      --no-follow-symlinks
                 Don't follow symlinks to directories
      --recurse  Recurse into subdirectories (Default)
      --no-recurse
                 Turns off recursing into subdirectories
   -n --file-include=string
                 Only include files mathcing the regex (Multiple)
   -N --int=string
      --include-type=string
                 Only include files the specified type (Mulitple)
                 see perldoc File::CodeSearch::Files available types
   -x --file-exclude=string
                 Don't include files mathcing the regex (Multiple)
   -X --ext=string
      --exclude-type=string
                 Don't include files the specified type (Mulitple)
                 see perldoc File::CodeSearch::Files available types
      --file-ignore=string
                 Replace the default ignore regex
   -d --file-ignore-add=string
                 Add this regex to the list of ignored files
   -r --file-ignore-remove=string
                 Remove this regex to the list of ignored files
  Output:
   -s --suround=int
                 Show int lines before and after a match
   -b --before=int
                 Show int lines before a match
   -a --after=int
                 Show int lines after a match
   -t --totals
                 Show the total number of lines & files matched
   -f --files-only
                 Show only the file names containg matches
   -L --last=[function|class|sub]
                 Show the last function, class or sub name found before the
                 matched line.
   -u --unique   Show only unique matches (just the match not the whole line)
      --limit=int
                 Only show this number of found search results
  Other:
   -E --execute=cmd
                 Run this command with the found files as arguments
   -P --project=string
                 Use the specified projects default settings
   -C --config=file
                 Use the specified file as the config file instead of the
                 deafult ~/.cs

   -v --verbose  Show more detailed option
      --version  Prints the version information
      --help     Prints this help information
      --man      Prints the full documentation for cs

=head1 DESCRIPTION

=head1 SUBROUTINES/METHODS

=head1 DIAGNOSTICS

=head1 CONFIGURATION AND ENVIRONMENT

A configuration file placed in ~/.csrc (or specified through --conf) allows
allows the setting of default values

  <default>
      smart = 1
  </default>
  <project proj>
    exclude = /path/to/excluded/dir
  </project>

If you were to create a symlink to cs called proj the proj options would be
selected automatically (unless you specify a project with --project).

=head1 DEPENDENCIES

=head1 INCOMPATIBILITIES

=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.

Please report problems to Ivan Wills (ivan.wills@gmail.com).

Patches are welcome.

=head1 AUTHOR

Ivan Wills - (ivan.wills@gmail.com)

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2009 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
All rights reserved.

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>.  This program is
distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.

=cut
