#!/usr/bin/perl

package Devel::FIXME;

use 5.008_000; # needs FH interface to var

use strict;
use warnings;

use Exporter;
use Scalar::Util qw/reftype/;
use List::Util qw/first/;
use Carp qw/carp croak/;

our @EXPORT = qw/FIXME/;
our @EXPORT_OK = qw/SHOUT DROP CONT/;
our %EXPORT_TAGS = ( "constants" => \@EXPORT_OK );

our $VERSION = 0.01;

# some constants for rules
sub CONT () { 0 };
sub SHOUT () { 1 };
sub DROP () { 2 };


my %lock; # to prevent recursion
our %rets; # return value cache
our $cur; # the current file, used in an eval
our $err; # the current error, for rethrowal
our $inited; # whether the code ref was installed in @INC, and all 

{ my $anon = ''; open my $fh, "<", \$anon or die $!; close $fh; } # otherwise perlio require stuff breaks

sub init {
	my $pkg = shift;
	unless($inited){
		$pkg->readfile($_) for ($0, sort grep { $_ ne __FILE__ } (values %INC)); # readfile on everything loaded, but not us (we don't want to match our own docs)
		$pkg->install_inc;
	}

	$inited = 1;
}

our $carprec = 0;

sub install_inc {
	my $pkg = shift;
	
	unshift @INC, sub { # YUCK! but tying %INC didn't work, and source filters are applied per caller. XS for source filter purposes is yucki/er/
		my $self = shift;
		my $file = shift;
		
		return undef if $lock{$file}; # if we're already processing the file, then we're in the eval several lines down. return.
		local $lock{$file} = 1; # set the lock

		unless (ref $INC[0] and $INC[0] == $self){ # if this happens, some stuff won't be filtered. It shouldn't happen often though.
			local @INC = grep { !ref or $_ != $self } @INC; # make sure we don't recurse when carp loads it's various innards, it causes a mess
			carp "FIXME's magic sub is no longer first in \@INC";
		}

		# create some perl code that gives back the return value of the original package, and thus looks like you're really requiring the same thing
		my $buffer = "\${ delete \$Devel::FIXME::rets{q{$file}} };"; # return what the last module returned. I don't know why it doesn't work without deref

		# really load the file
		local $cur = $file;
		my $ret = eval 'require $Devel::FIXME::cur'; # require always evaluates the return from an evalfile in scalar context

		($err = "$@\n") =~ s/\nCompilation failed in require at \(eval \d+\)(?:\[.*?\])? line 1\.\n//s;
		$buffer = 'die $Devel::FIXME::err' if $@; # rethrow this way for the sake of shutting up base
		
		# save the return value so that the original require can have it
		$rets{$file} = \$ret;

		# look for FIXME comments
		$pkg->readfile($INC{$file}) if ($INC{$file});

		open my $fh, "<", \$buffer;
		$fh; # empty stub like thing. Simply returns the last thing the real file did.
	};
}


sub readfile {
	my $pkg = shift;
	my $file = shift;

	return unless -f $file;	

	open my $src, "<", $file or die "couldn't open $file: $!";
	local $_;

	while(<$src>){
		$pkg->FIXME(
			text => "$1",
			line => $.,
			file => $file,
		) if /#\s*FIXME\s+(.*)$/; # if a file matches the comment, emit a warning.
	} continue { last if eof $src }; # is this a platform bug on OSX?
	close $src;
}

sub eval { # evaluate the rules, one by one
	my $self = shift;

	foreach my $rule ($self->rules){

		my $action = &$rule($self);

		if ($action == SHOUT){ # if the rule said to shout, we shout and stop
			return $self->shout;
		} elsif ($action == DROP){ # if the rule says to drop, we stop
			return undef;
		} # otherwise we keep looping through the rules
	}

	$self->shout; # and shout if there are no more rules left.
}

sub rules { }; # shout by default

sub shout { # generate a pretty string and send it to STDERR
	my $self = shift;
	warn("# FIXME: $self->{text} at $self->{file} line $self->{line}.\n");
}

sub new { # an object per FIXME statement
	my $pkg = shift;

	my %args;
	
	if (@_ == 1){ # if we only have one arg
		if (ref $_[0] and reftype($_[0]) eq 'HASH'){ # and it's a hash ref, then we take the hashref to be our args
			%args = %{ $_[0] };
		} else { # if it's one arg and not a hashref, then it's our text
			%args = ( text => $_[0] );
		}
	} elsif (@_ % 2 == 0){ # if there's an even number of arguments, they are key value pairs
		%args = @_;
	} else { # if the argument list is anything else we complain
		croak "Invalid arguments";
	}
	
	
	my $self = bless \%args, $pkg;

	# fill in some defaults
	$self->{package} ||= (caller(1))[0];
	$self->{file} ||= (caller(1))[1];
	$self->{line} ||= (caller(1))[2];

	$self->{script} ||= $0;
	
	$self->{time} ||= localtime;

	$self;
}

sub import { # export \&FIXME to our caller, /and/ generate a message if there is one to generate
	my $pkg = $_[0];
	$pkg->init;
	if (@_ == 1 or @_ > 2 or (@_ == 2 and first { $_[1] eq $_ or $_[1] eq "&$_" } @EXPORT_OK, map { ":$_" } keys %EXPORT_TAGS)){
		shift;
		local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
		$pkg->Exporter::import(@_);
	} else {
		goto \&FIXME;
	}
}

sub FIXME { # generate a method
	my $pkg = __PACKAGE__;
	$pkg = shift if UNIVERSAL::can($_[0],"isa") and $_[0]->isa(__PACKAGE__); # it's a method or function, we don't care
	$pkg->new(@_)->eval;
}
*msg = \&FIXME; # booya.

__PACKAGE__

__END__

=pod

=head1 NAME

FIXME - Semi intelligent, pending issue reminder system.

=head1 SYNOPSIS

	this($code)->isa("broken"); # FIXME what shall we fix?

=head1 DESCRIPTION

Usually we're too busy to fix things like circular refs, edge cases and things
when we're spewing code into the editor. A common thing to do is to make a
comment saying

	... # FIXME I hope someone finds this comment


somewhere in your code, and then search through your sources for occurrances of
I<FIXME> every now and then.

This works, pretty much, until your code base grows considerably, and you have
too many FIXMEs to prioritise properly.

The solution for me was to create this package, which gives the author an
"intelligent" way of being reminded.

=head1 DECLARATION INTERFACE

There are several ways to get your code fixed by you in some indeterminate time
in the future.

The first is a sort-of source filter based compile time fix, which does not
affect shipped code.

	$code; # FIXME broken

That's it. The most reasonable way to get it to work is to set the environment
variable I<PERL5OPT>, so that it contains C<-MFIXME>.

The second interface is a compile time, somewhat more explicit way of emmitting
messages.

	use Devel::FIXME "broken";

This can be repeated for additional messages as needed. This is useful if you
want your FIXMEs to break as you test it with a perl tree that doesn't have
FIXME.pm in it.

The third, and probably most problematic is a runtime, explicit way of emmitting
messages:

	$code; FIXME("broken");

This relies on FIXME to have been imported into the current namespace, which is
probably not always the case. Provided you know FIXME is loaded I<somewhere> in
the running perl interpreter, you can use a fully qualified version:

	$code; Devel::FIXME::FIXME("broken");

or if you feel that's not pretty enough:

	$code; Devel::FIXME->msg("broken");
	# or
	$code; Devel::FIXME::msg("broken");

But do use the former two methods instead.

=head1 OUTPUT FILTERING

=head2 Rationale

There are some problems with simply grepping for occurances of I<FIXME>:

=over 4

=item *

It's messy - you get a bajillion lines, if your source tree is big enough.

=item *

You need context, which can be provided for, but is a bit of work (and adds to
the clutter).

=item *

You (well I<me> anyway) forget to do it. And no, cron is not perfect for this.

=back

The solution to the first two problems is to make the reporting smart, so that
it decides which FIXMEs are printed and which arent.

The solution to the last problem is to have it happen automatically whenever
the source code in question is used.

=head2 Principal

The way FIXMEs are filtered is similar to how a firewall filters packets.

Each FIXME statement is considered as it is found, by iterating through some
rules, which ultimately decide whether to print the statement or not.

This may sound a bit overkill, but I think it's useful.

What it means is that you can get reminded of FIXMEs in source files that are
more than a week old, or when your release schedule reaches feature freeze, or
if your program is in the stable tree if your source management repository, or
whatever.

=head2 Practice

Currently the FIXMEs are filtered by calling the class method C<rules>, and
evaluating the subroutine references that are returned, as methods on the fixme
object.

In the future, a witty little grammer will be written, to allow you to do the
trivial things concisely, and use perl code for more complicated rules, in a
config file that is global to your settings.

=head1 BUGS

If I had a nickle for every bug you could find in this module, I would have
zero or more nickles.

=head1 COPYRIGHT & LICNESE

Same as perl.

=head1 AUTHOR

Yuval Kogman <nothingmuch@woobling.org>