#!/usr/bin/perl -w

use strict;



use File::Find;
use Pod::Text;
use IO::String;
use Data::Dumper;



main();



sub main {
	my $dir = $ARGV[0] || "./";
	my $fileOut = $ARGV[1] || "";


	my $noFile = 0;
	my $noBytes = 0;
	my $noLineSource = 0;
	my $noLineCode = 0;
	my $noLinePod = 0;
	my $noLineCommentLeft = 0;
	my $noLineCommentEnd = 0;
	my $noLineWhitespace = 0;
	my %hModuleUse;
	for my $file (@{raFileFind($dir)}) {
		$noFile++;

		my $text = loadFile($file) or next;
		my @aLine = split(/\n/, $text);

		if(my @aUse = ($text =~ /^use\s+([\w:]+)[;\s]?/mg)) {
			$hModuleUse{$_}++ for (@aUse);
			}


		$noBytes 		   += length($text);
		$noLineSource      += scalar(@aLine);
		$noLineCode        += scalar(grep { $_ =~ /\w/ } @aLine);
		$noLineCommentLeft += scalar(grep { $_ =~ /^\#/ } @aLine);
		$noLineCommentEnd  += scalar(grep { $_ =~ /.\#/ } @aLine);
		$noLineWhitespace  += scalar(grep { $_ !~ /\w/ } @aLine);

		#Create POD
		my $pod = "";
		my $fhOut = IO::String->new($pod);
		my $fhIn = IO::String->new($text);
		my $objParser = Pod::Text->new();
		eval {
			$objParser->parse_from_filehandle($fhIn, $fhOut);
			};	#Silently fail on any illegal POD
		$noLinePod += scalar($pod =~ tr/\n//);
		}

	my $noModule = scalar(keys %hModuleUse);
	my $sizeKb = int($noBytes / 1024);

	if(!$fileOut) {
		print "\n\n";
		print "*** MODULES *** \n";
		print "Total used: $noModule\n";
		print "\n";
		for my $mod (sort { $hModuleUse{$b} <=> $hModuleUse{$a} } keys %hModuleUse) {
			printf("%2d: $mod\n", $hModuleUse{$mod});
			}

		print "No files: $noFile\n\n";
		print "*** LINES ***\n";
		printf("Source (total): $noLineSource\n");
		printf("    Code + POD: " . ($noLineCode + $noLinePod) . " (%2d%%)\n", ($noLineCode + $noLinePod) / ($noLineSource || 1) * 100);
		printf("          Code: $noLineCode (%2d%%)\n", $noLineCode / ($noLineSource || 1) * 100);
		printf("           POD: $noLinePod (%2d%%) (%2d%% of code + POD lines)\n", $noLinePod / ($noLineSource || 1) * 100, $noLinePod / (($noLineCode + $noLinePod) || 1) * 100);
		printf(" Comments left: $noLineCommentLeft (%2d%%) of source\n", $noLineCommentLeft / ($noLineSource || 1) * 100);
		printf("  Comments EOL: $noLineCommentEnd (%2d%%) of code\n", $noLineCommentEnd / ($noLineCode || 1) * 100);
		printf("    Whitespace: $noLineWhitespace (%2d%%)\n", $noLineWhitespace / ($noLineSource || 0) * 100);
		printf("     Size (Kb): $sizeKb\n");

		print "\n";
		}
	else {
		my $in = "";
		$in = loadFile($fileOut) or $in = "Date\tnoFile\tnoLineSource\tnoLineCode\tnoLinePod\tnoLineCommentLeft\tnoLineCommentEnd\tnoLineWhitespace\tnoModule\tsizeKb\n";
		my $out = $in . localtime() . "\t$noFile\t$noLineSource\t$noLineCode\t$noLinePod\t$noLineCommentLeft\t$noLineCommentEnd\t$noLineWhitespace\t$noModule\t$sizeKb\n";
		saveFile($fileOut, $out);
		}
	}





=head1 ROUTINES

=head2 loadFile($file)

Slurp the text in $file and return it, or undef on errors.

=cut
sub loadFile {
	my ($file) = @_;

	open(my $fh, $file) or return(undef);
	local $/;
	<$fh>;
	}





=head2 saveFile($file, $text)

Save the $text in $file.

Return 1, or 0 on errors.

=cut
sub saveFile {
	my ($file, $text) = @_;

	open(my $fh, "> $file") or return(0);
	print $fh $text;

	return(1);
	}





=head2 raFileFind($dir)

Find Perl source files in $dir and below.

Return array ref with file names on success, or []
on errors.

=cut
sub raFileFind {
	my ($dir) = @_;

	$dir =~ s{\\}{//}g;		#Unify slashes

	my @aFile;
	find( sub { push(@aFile, $File::Find::name) if($_ =~ /\.(pm|pl|pod|t)$/); }, $dir);

	return(\@aFile);
	}





=head1 AUTHOR

Johan Lindström - johanl@bahnhof.se

Copyright (c) 2002.. Johan Lindström. All rights reserved. 
This program is free software; you can redistribute it 
and/or modify it under the same terms as Perl itself.

=cut





__END__