package Devel::Optrace;

use 5.008_001;
#use strict;
#use warnings;

BEGIN{
	our $VERSION = '0.05';

	require XSLoader;
	XSLoader::load(__PACKAGE__, $VERSION);

	$^H |= 0x600; # use strict qw(subs vars);
}

our $DB; # tracing flags

my %bits = (
	-trace   => DOf_TRACE,
	-stack   => DOf_STACK,
	-runops  => DOf_RUNOPS,

	-noopt   => DOf_NOOPT,
	-count   => DOf_COUNT,

	-all     => DOf_DEFAULT,
);


sub import{
	my $class = shift;

	if($^P != 0){
		push @_, -all;
	}

	while(scalar(@_) && $_[0] =~ /^-/){
		my $opt   = shift;
		my $value = (scalar(@_) && $_[0] =~ /^[01]$/ ? shift : 1);
		$class->set($opt => $value);
	}

	#no strict 'refs';
	*{caller() . '::p'} = \&p;
	return;
}

sub enable{
	$DB |=  DOf_DEFAULT;
}
sub disable{
	$DB &= ~DOf_DEFAULT;
}

sub set{
	my($class, $opt, $value) = @_;
	my $bit = $bits{$opt};

	unless(defined $bit){
		require Carp;
		Carp::croak(qq{Unknown option "$opt"});
	}

	if($value){
		$DB |= $bit;
	}
	else{
		$DB &= ~$bit;
	}

	return;
}


1;
__END__

=head1 NAME

Devel::Optrace - Traces opcodes which are running now

=head1 VERSION

This document describes Devel::Optrace version 0.05.

=head1 SYNOPSIS

	use Devel::Optrace;
	Devel::Optrace->enable();  # enables  -trace, -stack and -runops
	# ...
	Devel::Optrace->disable(); # disables -trace, -stack and -runops

	# or command line:
	# $ perl -MDevel::Optrace=-all -e '...'  # normal way
	# $ perl -d:Optrace -e '...'             # shortcut


=head1 DESCRIPTION

Devel::Optrace is an opcode debugger which traces opcodes and stacks.

There are several trace options:

=over 4

=item -trace

Traces opcodes like perl's C<-Dt>, reporting
C<"$opcode @op_private @op_flags"> or C<"$opcode(@op_data) @op_private @op_flags">.

The indent level indicates the depth of the context stacks.

=item -stack

Dumps the perl stack (C<PL_stack>) like perl's C<-Ds>.

=item -runops

Traces C<runops> levels with the current stack info type (MAIN, OVERLOAD, DESTROY, etc.).

=item -all

Sets C<-trace>, C<-stack> and C<-runops> on/off.

=item -count

Counts and reports opcodes executed.

=item -noopt

Disable the peephole optimizer.

=back

=head1 EXAMPLES

C<< perl -d:Optrace -e 'print qq{Hello, @ARGV world!\n}' Perl >>:

	Entering RUNOPS MAIN (-e:0)
	()
	enter
	 ()
	 nextstate(main -e:1) VOID
	 ()
	 pushmark SCALAR
	 ()
	 const("Hello, ") SCALAR
	 ("Hello, ")
	 pushmark SCALAR
	 ("Hello, ")
	 gvsv($") SCALAR
	 ("Hello, "," ")
	 gv(*ARGV) SCALAR
	 ("Hello, "," ",*ARGV)
	 rv2av LIST KIDS
	 ("Hello, "," ","Perl")
	 join SCALAR KIDS
	 ("Hello, ","Perl")
	 concat SCALAR KIDS
	 ("Hello, Perl")
	 const(" world!\n") SCALAR
	 ("Hello, Perl"," world!\n")
	 concat SCALAR KIDS STACKED
	 ("Hello, Perl world!\n")
	 print VOID KIDS
	 (YES)
	 leave VOID KIDS PARENS
	()
	Leaving RUNOPS MAIN (-e:0)

This reveals that the perl code C<< print qq{Hello, @ARGV world!\n} >> is
interpreted as C<< print qq{Hello, } . join($", @ARGV) . qq{ world!\n} >>.

=head1 DEPENDENCIES

Perl 5.8.1 or later, and a C compiler.

=head1 BUGS

No bugs have been reported.

Please report any bugs or feature requests to the author.

=head1 SEE ALSO

L<perlrun>.

L<B::Concise>.

=head1 AUTHOR

Goro Fuji (gfx) E<lt>gfuji(at)cpan.orgE<gt>.

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2009, Goro Fuji (gfx). Some rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut