#!/usr/bin/env perl
#
#  This file is part of WebDyne.
#
#  This software is copyright (c) 2026 by Andrew Speer <andrew.speer@isolutions.com.au>.
#
#  This is free software; you can redistribute it and/or modify it under
#  the same terms as the Perl 5 programming language system itself.
#
#  Full license text is available at:
#
#  <http://dev.perl.org/licenses/>
#



#  Compiler pragma
#
use strict qw(vars);
use vars   qw($VERSION);


#  Use the base modules
#
use WebDyne::Util;
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);
use FindBin qw($RealBin $Script);
$Data::Dumper::Indent=1;


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


#  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 module 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/Util.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__





=pod

=head1 wddebug(1)

=head1 NAME

wddebug - enable or disable debugging in the WebDyne packages

=head1 SYNOPSIS

C<<<< wddebug [--OPTION] >>>>

C<<<< wddebug --enable >>>>

C<<<< wddebug --enable --directory /opt/perl5 >>>>

=head1 Description

By default debugging is optimized out of the WebDyne modules to increase performance. This script can be used to enable or disable debugging for troubleshooting purposes. Debugging can be turned on or off in the WebDyne modules by running this script with the appropriate option. With no options the script will return the current status of debugging in the WebDyne
 modules.

=head1 Options

=over

=item * B<<< --status >>>

Display the current debug status of the WebDyne modules. The default if no option given.

=item * B<<< --enable >>>

Enable debugging in the WebDyne modules.

=item * B<<< --disable >>>

Disable debugging in the WebDyne modules.

=item * B<<< --directory >>>

Specify the directory containing the WebDyne modules.

=item * B<<< --yes >>>

Automatically confirm the prompt to proceed with enabling or disabling debugging.

=item * B<<< --help|? >>>

Display a brief help message and exit.

=item * B<<< --man >>>

 Display the full manual page.

=item * B<<< --version >>>

Display the script version and exit.

=back

=head1 Examples

    # Show current status
    #
    $ wddebug
    debug location: /opt/perl5/lib/perl5/
    debug  enabled: WebDyne.pm
    debug disabled: WebDyne/Handler.pm
    ...
    
    # Turn on debugging for WebDyne modules 
    #
    $ wddebug --enable
    
    # Turn off debugging
    #
    $ wddebug --disable
    
    # Install modules from source with debugging enabled
    #
    $ WEBDYNE_DEBUG=1 perl Makefile.PL
    $ make install

=head1 Notes

Debugging is enabled in all source modules in the form of debug('message') calls. These calls are optimized out of the code during installation via a PM_FILTER in MakeMaker unless the WEBDYNE_DEBUG environment variable is set. Once optimised out the debug calls are not available for use as they are converted in the code to the form ` C<<<< 0 &&
    debug('message') >>>> , which is optimised away by the Perl compiler. This script will enable or disable the debug calls in already installed modules by adding or removing the  C<<<< 0
    && >>>>  prefix from the code.  B<<< As this edits installed modules it is not recommended for use in a production environment >>> . If debugging is necessary it is better to install WebDyne on a test system with the command:

    $ WEBDYNE_DEBUG=1 perl Makefile.PL && make install

=head1 Debugging

Actual debugging output is controlled by environment variables. See the WebDyne documentation for more information but in brief, setting the  WEBDYNE_DEBUG  environment variable to a value of 1 will enable all debugging output. Setting it to a string value that corresponds to a module or method will filter the debugging output to that module or
 method.

    # Debug compilation of a file
    #
    WEBDYNE_DEBUG=1 wdcompile time.psp
    
    # Debug render of a file
    #
    WEBDYNE_DEBUG=1 wdrender time.psp
    
    # Debug a specific method
    #
    WEBDYNE_DEBUG=render wdrender time.psp
    
    # Multiple methods can be debugged
    #
    WEBDYNE_DEBUG=render,compile wdrender time.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) 2026 by Andrew Speer L<mailto:andrew.speer@isolutions.com.au>.

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

Full license text is available at:

L<http://dev.perl.org/licenses/>

=cut