The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
#  This file is part of WebDyne.
#
#  This software is Copyright (c) 2017 by Andrew Speer <andrew@webdyne.org>.
#
#  This is free software, licensed under:
#
#    The GNU General Public License, Version 2, June 1991
#
#  Full license text is available at:
#
#  <http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt>
#

#
#  Enable/disable debug in the WebDyne packages
#
package main;


#  Compiler pragma, load library path
#
sub BEGIN {

    #  Massage warnings and @INC path
    $^W=0;
    use File::Spec;
    use FindBin qw($RealBin $Script);
    foreach my $dn ($RealBin, File::Spec->path()) {
        if (-f (my $fn=File::Spec->catfile($dn, 'perl5lib.pl'))) {
            require $fn;
            perl5lib->import(File::Spec->catdir($dn, File::Spec->updir()));
            last;
        }
    }
}
use strict qw(vars);
use vars qw($VERSION);


#  Use the base modules
#
use WebDyne::Base;
use WebDyne;


#  External modules
#
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
use File::Find;
use File::Spec;
use IO::File;
use Cwd qw(realpath);
use File::Temp qw(tempfile);
use File::Copy qw(move);
use ExtUtils::MakeMaker qw(prompt);


#  Version Info, must be all one line for MakeMaker, CPAN.
#
$VERSION='1.250';


#  Run main
#
exit ${&main(\@ARGV) || die errdump()};


#===================================================================================================


sub main {


    #  Get argv array ref
    #
    my $argv_ar=shift();


    #  Now import command line options.
    #
    my %opt;
    GetOptions(
        \%opt, qw(
            status
            enable
            disable
            version
            help|?
            man
            directory:s
            yes
            ));
    pod2usage(-verbose => 99, -sections => 'Synopsis|Options', -exitval => 1) if $opt{'help'};
    pod2usage(-verbose => 2) if $opt{'man'};
    $opt{'version'} && do {print "$Script version: $VERSION\n"; exit 0};


    #  Check if user really wants to do this
    #
    if (($opt{'enable'} || $opt{'disable'}) && !$opt{'yes'}) {
        my $yesno=ExtUtils::MakeMaker::prompt(
            "\nWARNING: This script will edit installed WebDyne.pm and support files to turn on/off debugging. " .
                "It is intended only for use in a test environment, and may have unintended consquences:\n\n" .
                'Are you sure you wish to proceed ?', 'no'
        );
        exit 0 unless ($yesno=~/^y/i);
        print "\n";
    }


    #  User can specify only one file, or file path to modify from command line
    #
    my $debug_fn=$argv_ar->[0];


    #  Whihc routines to run
    #
    my $debug_cr;
    if ($opt{'enable'}) {
        $debug_cr=\&enable;
    }
    elsif ($opt{'disable'}) {
        $debug_cr=\&disable;
    }
    else {
        #$debug_cr=\&status;
        $debug_cr=sub {\undef};
    }


    #  Find base location of the actual WebDyne module and test
    #
    my %webdyne_fn;
    my ($webdyne_dn, $webdyne_pm);
    unless ($webdyne_dn=$opt{'directory'}) {
        $webdyne_dn=$webdyne_pm=$INC{'WebDyne.pm'};
        my $webdyne_fn=(File::Spec->splitpath($webdyne_dn))[2];
        $webdyne_dn=~s/\Q$webdyne_fn\E$//;
        print "debug location: $webdyne_dn\n"
    }
    else {
        $webdyne_pm=File::Spec->catfile($webdyne_dn, 'WebDyne.pm');
        unless (-f $webdyne_pm) {
            return err ("unable to find Webdyne.pm in directory: $webdyne_dn !");
        }
    }
    if (!$debug_fn || ($debug_fn && ($webdyne_pm=~/\Q$debug_fn\E$/))) {
        $debug_cr->($webdyne_pm) ||
            return err ();
        &status($webdyne_pm, $webdyne_dn) ||
            return err ();
        $webdyne_fn{$webdyne_pm}++;
    }


    #  Now all sub modules
    #
    my $webdyne_display_dn;
    unless ($webdyne_dn=$opt{'directory'}) {
        $webdyne_dn=$INC{'WebDyne/Base.pm'};
        my $webdyne_fn=(File::Spec->splitpath($webdyne_dn))[2];
        $webdyne_dn=~s/\Q$webdyne_fn\E$//;
        $webdyne_display_dn=realpath(File::Spec->catdir($webdyne_dn, File::Spec->updir));
    }
    else {
        $webdyne_display_dn=$webdyne_dn;
        $webdyne_dn=File::Spec->catfile($webdyne_dn, 'WebDyne');
    }
    my $wanted_cr=sub {
        return unless $File::Find::name=~/.pm$/;
        return if $webdyne_fn{$File::Find::name}++;
        if ($debug_fn) {
            return unless $File::Find::name=~/\Q$debug_fn\E$/
        }
        $debug_cr->($File::Find::name) ||
            return err ();
        &status($File::Find::name, $webdyne_display_dn) ||
            return err ();
    };
    find($wanted_cr, $webdyne_dn);


    #  Done
    #
    return \undef;


}


sub enable {

    my $fn=shift();
    my $fh=IO::File->new($fn, O_RDONLY) || return err (
        "unable to open file $fn for read, $!"
    );
    my ($temp_fh, $temp_fn)=tempfile();
    my $modified;
    while (my $line=<$fh>) {
        if ($line=~/^\s*(\d?)\s+&&\s+debug/) {
            if ($1 eq '0') {
                $line=~s/^(\s*)(\d+)/${1}1/;
                $modified++;
            }
        }
        print $temp_fh $line or
            return err ("unable to print to temp file handle, $!");
    }
    $fh->close();
    $temp_fh->close();
    if ($modified) {
        my $perm;
        if ($^O=~/MSWin[32|64]/) {
            system('attrib', '-r', $fn);
        }
        else {
            my $perm=(stat $fn)[2] & 07777;
            chmod($perm | 0600, $fn);
        }
        move($temp_fn, $fn) ||
            return err ("unable to move $temp_fn=>$fn, $!");
        chmod($perm, $fn) if $perm;
    }

    return \undef;

}


sub disable {

    my $fn=shift();
    my $fh=IO::File->new($fn, O_RDONLY) || return err (
        "unable to open file $fn for read, $!"
    );
    my ($temp_fh, $temp_fn)=tempfile();
    my $modified;
    while (my $line=<$fh>) {
        if ($line=~/^\s*(\d?)\s+&&\s+debug/ || $line=~/^\s*debug/) {
            if ($1 == 1) {
                $line=~s/^(\s*)(\d+)/${1}0/;
                $modified++;
            }
            elsif ($1 eq '') {
                $line=~s/debug(\s*)\(/0 && debug$1\(/;
                $modified++;
            }
        }
        print $temp_fh $line or
            return err ("unable to print to temp file handle, $!");
    }
    $fh->close();
    $temp_fh->close();
    if ($modified) {
        my $perm;
        if ($^O=~/MSWin[32|64]/) {
            system('attrib', '-r', $fn);
        }
        else {
            my $perm=(stat $fn)[2] & 07777;
            chmod($perm | 0600, $fn);
        }
        move($temp_fn, $fn) ||
            return err ("unable to move $temp_fn=>$fn, $!");
        chmod($perm, $fn) if $perm;
    }

    return \undef;

}


sub status {

    my ($fn, $dn)=@_;
    my $fh=IO::File->new($fn, O_RDONLY) || die(
        "unable to open file $fn for read, $!"
    );
    my ($debug, $found);
    while (my $line=<$fh>) {
        next unless ($line=~/^\s*(\d?)\s+&&\s+debug/ || $line=~/^\s*debug/);

        #print "line $line, $1\n";
        $debug=($1 eq '0') ? 0 : 1;
        $found++;
        last;
    }
    $fh->close();
    $fn=~s/^\Q$dn\E//;
    $fn=~s/^\///;
    my $result;
    if ($debug) {
        $result=' enabled'
    }
    elsif ($found) {
        $result='disabled'
    }
    else {
        $result='     n/a'
    }
    print "debug $result: $fn\n";

    return \undef;

}

__END__

=head1 Name

wddebug - enable or disable debugging within WebDyne modules

=head1 Synopsis

B<wddebug> B<[OPTIONS]> B<<FILE>>

=head1 Options

-h, --help
Show brief help message.


=over 5


=item -m, --man




Show the manual page


=item --status




Show the current status of debugging within the module tree. This
is the default if no options are given.


=item --enable




Enable debugging within the module tree


=item --disable




Disable debugging within the module tree.


=item --directory




Manually specify the directory where the module tree resides.


=item --yes




Bypass confirmation message


=item --version




Display cersion information.


=back

A file name may be optionally specified to specifically enable or
disable debugging for only one module.

=head1 Description

The L<wddebug(1)> command will enable or disable debugging within the
WebDyne suite of modules.

B<wddebug> acts by editing the content of the WebDyne modules to enable or
disable debugging routines. Debugging is controlled this way (rather
than at runtime) to ensure that WebDyne modules run at the fastest
possible speed when debugging is disabled.

When disabled debugging statements within each module are prefixed with
the command "0 &&" (as in: 0 && debug "xyz"), which are optimised away
at runtime by the Perl bytecode compiler.

When debugging is enabled the "0 &&" is replaced by "1 &&" to ensure
that the debug statements are called at run-time.

Enabling and disabling debugging in this way is generally considered
bad practice - for this reason this utility should only be used in an
isolated test or development environment. The routine will modify all
modules in the WebDyne directoy and below, and may have undesired (or
unintended) consquence on any module that resides in those directories.

For this reason the B<wddebug> utility should be used with extreme care !

=head1 Usage

Enable global debugging:

B<wddebug> B<--enable>

Or for just one module

B<wddebug> B<--enable> B<WebDyne/Session.pm>

Debug output can then be displayed by setting the B<WEBDYNE_DEBUG>
environment variable.

B<WEBDYNE_DEBUG=1> B<wdrender> B<test.psp>

Will display debug output when rendering a test page. You can filter
down to one module by setting the environment variable to the
method/subroutine you are interested in:

B<WEBDYNE_DEBUG=WebDyne::handler> B<wdrender> B<test.psp>

Will only show debug information from the WebDyne::handler method.

Debug information can be saved to a file by setting the
B<WEBDYNE_DEBUG_FILE> environment variable:

B<WEBDYNE_DEBUG_FILE=/tmp/webdyne.log> B<wdrender> B<test.psp>

If you require file output to be filtered you can combine the two
environment variables

B<WEBDYNE_DEBUG_FILE=/tmp/webdyne.log> B<WEBDYNE_DEBUG=WebDyne::handler>
B<wdrender> B<test.psp>

=head1 Author

Written by Andrew Speer, andrew@webdyne.org

=head1 LICENSE and COPYRIGHT

This file is part of WebDyne.

This software is Copyright (c) 2017 by Andrew Speer <andrew@webdyne.org>.

This is free software, licensed under:

  The GNU General Public License, Version 2, June 1991

Full license text is available at:
L<http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt>