#
# This file is part of Language::Befunge.
# Copyright (c) 2001-2009 Jerome Quelin, all rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
#

package Language::Befunge::Debug;

use 5.010;
use strict;
use warnings;

use base qw{ Exporter };
our @EXPORT = qw{ debug };


# -- public subs

sub debug {}

my %redef;
sub enable {
    %redef = ( debug => sub { warn @_; } );
    _redef();
}

sub disable {
    %redef = ( debug => sub {} );
    _redef();
}


# -- private subs

#
# _redef()
#
# recursively walk the symbol table, and replace subs named after %redef
# keys with the matching value of %redef.
#
# this is not really clean, but since the sub debug() is exported in
# other modules, replacing the sub in *this* module is not enough: other
# modules still refer to their local copy.
#
# also, calling sub with full name Language::Befunge::Debug::debug() has
# performance issues (10%-15%) compared to using an exported sub...
#
my %orig; # original subs
sub _redef {
    my $parent = shift;
    if ( not defined $parent ) {
        $parent = '::';
        foreach my $sub ( keys %redef ) {
            $orig{ $sub } = \&$sub;
        }
    }
    no strict   'refs';
    no warnings 'redefine';
    foreach my $ns ( grep /^\w+::/, keys %{$parent} ) {
        $ns = $parent . $ns;
        _redef($ns) unless $ns eq '::main::';
        foreach my $sub (keys %redef) {
            next                                       # before replacing, check that...
                unless exists ${$ns}{$sub}             # named sub exist...
                && \&{ ${$ns}{$sub} } == $orig{$sub};  # ... and refer to the one we want to replace
            *{$ns . $sub} = $redef{$sub};
        }
    }
}

1;

__END__

=head1 NAME

Language::Befunge::Debug - optimized debug solution for language::befunge


=head1 SYNOPSIS

    use Language::Befunge::Debug;
    debug("foo\n");     # does nothing by default
    Language::Befunge::Debug::enable();
    debug("bar\n");     # now that debug is enabled, output on STDERR
    Language::Befunge::Debug::disable();
    debug("baz\n");     # sorry dave, back to no output



=head1 DESCRIPTION

This module provides a C<debug()> subroutine, which output on STDERR if
debugging is enabled. If debugging is disabled (the default), perl will
optimize out those debugging calls.



=head1 PUBLIC API

=head2 Exported functions

The module is exporting only one function:

=over 4

=item * debug( @stuff );

If debugging is enabled (which is B<not> the default), write C<@stuff>
on STDERR.

=back


=head2 Other functions

The module also provides 2 functions to control debugging:

=over 4

=item * Language::Befunge::Debug::enable();

Request that calls to C<debug()> really start output on STDERR.


=item * Language::Befunge::Debug::disable();

Request that calls to C<debug()> stop output-ing on STDERR.


=back



=head1 SEE ALSO

L<Language::Befunge>



=head1 AUTHOR

Jerome Quelin, C<< <jquelin@cpan.org> >>

Development is discussed on C<< <language-befunge@mongueurs.net> >>



=head1 COPYRIGHT & LICENSE

Copyright (c) 2001-2009 Jerome Quelin, all rights reserved.

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


=cut