#!/usr/bin/perl
#
# PHP deprecated functions checker.
#
# $Id       : php-deprecated $
# $HeadURL  : http://www.bobotig.fr/ $
# $Source   : http://www.bobotig.fr/ $
# $Author   : BoboTiG $
# $Revision : 1 $
# $Date     : 2011/07/18 $
#
# It will store all found functions into a file php-deprecated.db.
# Functions which start by '!' are deprecated.
# Functions which start by '?' should be user defined.
#  => It is a little caching system to speed up process.
#
# You can remove it to rebuild a new database.
# You can choose the database file by modifying $database at line 28.
#
#
# Examples -------------------------------------------------------------
#
# Check one file
#    php-deprecated file.php
#
# Check one file
#    cat file.php | php-deprecated -
#
# Check several files - this example is deprecated ;)
# (because you could not know which file is analyzed)
#    cat *.php | php-deprecated -
#  
# Check several files - this is the good way
#    for file in $(find . -type f -name "*.php"); do
#       php-deprecated "${file}"
#    done
#

use 5.010;
use strict;
use warnings;
use autodie 'close';
use LWP::UserAgent;


our $VERSION = 0.2;
my $database = '/home/tiger-222/.php-deprecated.db';
my $link     = 'http://php.net/manual/en/function.';
my $rrrrrrhh = '<em class="emphasis">DEPRECATED</em>';
my $regexp   = '((function |new |)[:\->\w]{4,})[\s]{0,}\(';
my $ignore   = '^(case|catch|elseif|foreach|switch|while)$';
my $fals_pos = '(^(function|new) |:|>)';
my $file     = q{-};
my $i        = 0;
my $input    = shift || undef;
my %matches;


# ----------------------------------------------------------------------
# Fonction	: _stdin
# Objectif	: good replacement for <STDIN> to avoid perlcritic warn :
#			  ' Use "<>" or "<ARGV>" or a prompting module instead of 
#			  "<STDIN>" '
# Entries	: none
# Returns	: (string)user input
# Update	: 20100729
#
sub _stdin {
	my $io;
	my $string = q{};

	$io = IO::Handle->new();
	if ( $io->fdopen(fileno(STDIN), 'r') ) {
		$string = $io->getline();
		$io->close();
	}
	chomp $string;
	return $string;
} #end _stdin ----------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: check
# Objectif	: verifiy if a function is deprecated
# Entries	: 
#		- (string)function name
#		- (string)line where the function was found
# Returns	: void
# Update	: 20110717
#
sub check {
	my $name = shift;
	my $line = shift;
	my $url  = $link.sanitize($name).'.php';
	my $content;
	
	printf 'Checking line %d/%d ...'."\n", $line, $i;
	print "\e[A";
		# "\e[A" is the VT-100 code to move the cursor up one line.
		
	if ( ! defined $matches{$name}{count} ) {
		wget($url, \$content);
		if ( $content ne q{} ) {
			if ( $content =~ m/$rrrrrrhh/ ) {
				$matches{$name}{bad} = 1;
				report($name, $line, $url);
				update_known(q{!}.$name);
			} else {
				$matches{$name}{bad} = 0;
				update_known($name);
			}
		} else {
			#printf " ! Unable to check the function '%s' at line %d.\n",
			#	$name, $line;
			$matches{$name}{bad} = 2;
			update_known(q{?}.$name);
		}
	} elsif ( $matches{$name}{bad} == 1 ) {
		report($name, $line, $url);
	}
	++$matches{$name}{count};
	return;
} #end check -----------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: get_known
# Objectif	: retrieve already deprecated functions
# Entries	: none
# Returns	: void
# Update	: 20110718
#
sub get_known {
	if ( open my $F, '<', $database ) {
		while ( <$F> ) {
			next if ! defined $_;
			chomp $_;
			my $c = substr $_, 0, 1;
			my $name = $_;
			my $code = 0;
			
			if ( $c eq q{!} ) {
				$name = substr $name, 1, (length($name) - 1);
				$code = 1;
			} elsif ( $c eq q{?} ) {
				$name = substr $name, 1, (length($name) - 1);
				$code = 2;
			}
			
			++$matches{$name}{count};
			$matches{$name}{bad} = $code;
		}
		close $F;
	}
	return;
} #end get_known -------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: purge
# Objectif	: purge inline multiline comment
# Entries	: (string)line
# Returns	: (string)line purged
# Update	: 20110718
#
sub purge {
	my $line = shift;
	my @compartments = split q!/\*!, $line;
	my $str;
	
	foreach my $compartment ( @compartments ) {
		if ( $compartment =~ m{\*/}m ) {
			$str .= (split q!\*/!, $compartment)[1];
		} else {
			$str .= $compartment;
		}
	}
	return $str;
} #end purge -----------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: report
# Objectif	: print deprecated function found
# Entries	: 
#		- (string)function name
#		- (int)line where function was found
#		- (string)link to the function manual
# Returns	: void
# Update	: 20110718
#
sub report {
	my $name   = shift;
	my $line   = shift;
	my $url    = shift;
	my $red    = "\033[31m";
	my $green  = "\033[32m";
	my $yellow = "\033[33m";
	my $blue   = "\033[34m";
	my $normal = "\033[0m";
	
	if ( $matches{$name}{$line}{count} > 1 ) {
		$matches{$name}{bad} = -1;
		printf 
			' ! Deprecated function %s%s%s (%sx%d%s) at line %s%d%s.'."\n", 
			$red, $name, $normal,
			$green, $matches{$name}{$line}{count}, $normal , 
			$yellow, $line, $normal;
	} else {
		printf 
			' ! Deprecated function %s%s%s at line %s%d%s.'."\n", 
			$red, $name, $normal, 
			$yellow, $line, $normal;
	}
	say    '     ++informations at '.$blue.$url.$normal;
} #end report ----------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: sanitize
# Objectif	: sanitize the function name
# Entries	: (string)function name
# Returns	: (string)function name sanitized
# Update	: 20110717
#
sub sanitize {
	my $str = shift;
	
	$str =~ s/_/-/g;
	return $str;
} #end sanitize --------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: start
# Objectif	: main function
# Entries	: none
# Returns	: void
# Update	: 20110718
#
sub start {
	my $contents;
	my @functions;
	my $multi_line_comment = 0;
	
	if ( ! defined $input ) {
		say '  Usage: php-deprecated <input>';
		say '  Where  <input> is a file or "-" to read from STDIN.';
		exit 1;
	} elsif ( $input eq q{-} ) {
		say ' + reading from STDIN';
	} else {
		say ' + Reading file '.$input;
	}
	
	# Fill %matches with already known deprecated functions
	get_known();
	
	if ( $input eq q{-} ) {
		while ( <> ) {
			++$i;
			next if ! defined $_;
			test_line($_, $i, \$multi_line_comment, \@functions);
		}
	} else {
		if ( open my $F, '<', $input ) {
			$file = $input;
			while ( <$F> ) {
				++$i;
				next if ! defined $_;
				test_line($_, $i, \$multi_line_comment, \@functions);
			}
			close $F;
		} else {
			say ' ! Bad input file.';
		}
	}
	
	# ChecKING!
	foreach my $function ( @functions ) {
		my ($name, $line) = split /:/, $function;
		check($name, $line);
	}
	return;
} #end start -----------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: test_line
# Objectif	: try to found functions from a line
# Entries	: 
#		- (string)line
#		- (int)line number
#		- (ref)current line is into a comment on multiple lines [bool]
#		- (ref)reference to the @functions array
# Returns	: void
# Update	: 20110718
#
sub test_line {
	my $line               = shift;
	my $i                  = shift;
	my $multi_line_comment = shift;
	my $functions          = shift;
	
	# Discard comments
	$line = purge($line);
	if ( $$multi_line_comment == 1 ) {
		if ( $line =~ m{\*/}m ) {
			$$multi_line_comment = 0;
		}
		return;
	} elsif ( $line =~ m!/\*! ) {
		if ( $line !~ m{\*/}m ) {
			$$multi_line_comment = 1;
		}
		return;
	}
	$line = (split q!//|#!, $line)[0];

	# Let's go!
	my (@ff) = $line =~ m/$regexp/g;
	foreach my $func ( @ff ) {
		if ( defined $func && $func !~ m/$ignore/ ) {
			if ( $func =~ m/$fals_pos/ ) {
				# Discard function func_name() and new func_name()
				my (undef, $f) = split / /, $func;
				# Discard $this->func_name()
				   (undef, $f) = split />/, $func if ! defined $f;
				# Discard $self::func_name()
				   (undef, $f) = split /:/, $func if ! defined $f;
				$func = $f;
				++$matches{$f}{count};
				$matches{$f}{bad} = 2;
			} else {
				push @$functions, $func.q{:}.$i if $func ne 'function';
			}
			++$matches{$func}{$i}{count};
		}
	}
	return;
} #end test_line -------------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: update_known
# Objectif	: update the known file
# Entries	: (string)function name
# Returns	: void
# Update	: 20110718
#
sub update_known {
	my $name = shift;
	if ( open my $F, '>>', $database ) {
		print $F $name."\n";
		close $F;
	}
	return;
} #end update_known ----------------------------------------------------

# ----------------------------------------------------------------------
# Fonction	: wget
# Objectif	: retrieve webpage content
# Entries	: 
#		- (string)link to the website
#		- (ref)reference to the content scalar
# Returns	: void
# Update	: 20110717
#
sub wget {
	my $url        = shift;
	my $ref_string = shift;
	my $ua;
	my $req;
	my $requete;
	
	$ua = new LWP::UserAgent;
	$ua->agent('Mozilla/5.0 (X11; U; Linux x86_64; us; rv:1.9.1.9) Iceweasel/3.5.9');
	$req = HTTP::Request->new(GET => $url);
	$requete = $ua->request($req);
	if ( $requete->is_success ) {
		$$ref_string = $requete->content;
	} else {
		$$ref_string = q{};
	}
	return;
} #end wget ------------------------------------------------------------


# C'est parti mon kiki !
say ' ~ PHP deprecated functions checker v'.$VERSION.' { BoboTiG } ~';
start();
say ' ^ Done.'. ' ' x 40;
exit 0;