File Coverage

bin/wdrender

Criterion	Covered	Total	%
statement	77	96	80.2
branch	13	26	50.0
condition	4	11	36.3
subroutine	14	14	100.0
pod			n/a
total	108	147	73.4

#!/usr/bin/env perl
#
#  This file is part of WebDyne.
#
#  This software is copyright (c) 2026 by Andrew Speer .
#
#  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:
#
#
#


#
#  Compile and/or show compiled version of WebDyne HTML scripts
#
package main;


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


#  Use the base module
#
use WebDyne::Util;


#  Other external modules
#
use WebDyne;
use WebDyne::Request::Fake;
use Getopt::Long;
use Pod::Usage;
use IO::File;
use File::Spec;
use FindBin qw($RealBin $Script);
use URI::Escape;


#  Error handling and environment
#
use Carp;
local $SIG{__DIE__}=\&Carp::confess;


#  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();


    #  Defaul options
    #
    my %opt=(

        handler => $ENV{'WebDyneHandler'} || 'WebDyne',
        error   => 'text',
        header  => 0,
        warn    => 0,

    );


    #  Get command line options
    #
    GetOptions(
        \%opt,
        'help|?',
        'handler=s',
        'status=s',
        'header!',
        'warn!',
        'error=s',
        'headers_out|header_out=s@',
        'headers_in|header_in=s@',
        'outfile=s',
        'repeat|r|num|n=s',
        'loop',
        'get=s@',
        'delay=i',
        'man',
        'version'
    ) || pod2usage(2);
    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";
        print "WebDyne version: $WebDyne::VERSION ($WebDyne::VERSION_GIT_SHA)\n";
        exit 0
    };


    #  Is dest file set ? If so open
    #
    my $dest_fh;
    if (my $dest_fn=$opt{'outfile'}) {
        $dest_fh=IO::File->new($dest_fn, O_CREAT | O_TRUNC | O_WRONLY) ||
            return err("unable to open file $dest_fn for output, $!");
        $opt{'select'}=$dest_fh;
    }


    #  Get srce file, add to options
    #
    my $srce_fn=shift(@{$argv_ar}) ||
        pod2usage("$Script: no source file specified !");
    (-f $srce_fn) ||
        pod2usage("$Script: input file not found !");


    #  Split out header in/out arrays as Request::Fake uses hash to hold them (should be array one day)
    #
    my ($header_out_ar, $header_in_ar)=map {delete $opt{$_}} qw(
        headers_out
        headers_in
    );


    #  Simulate a GET request with parameters if supplied
    #
    if (my $query_opt_ar=delete $opt{'get'}) {
        my @query_string;
        my @query_opt=map { split(/[;&]/) } @{$query_opt_ar};
        foreach my $query_opt (@query_opt) {
            my ($key, $value)=split(/=/, $query_opt);
            push @query_string, join('=', map { uri_escape($_) } ($key, $value));
        }
        my $query_string=join('&', @query_string );
        ## no critic (Variables::RequireLocalizedPunctuationVars)
        $ENV{'QUERY_STRING'}=$query_string;
        $ENV{'REQUEST_METHOD'}='GET';
        ## use critic
    }


    #  Get new request object
    #
    LOOP: while (1) {
        for (1..($opt{'repeat'} || 1)) {

            #  Get new request handler
            #
            my $r=WebDyne::Request::Fake->new(

                filename => $srce_fn,
                %opt

                #select          =>  $dest_fh,
                #status          =>  $opt{'status'},

            ) || return err();


            #  Set headers
            #
            foreach my $header_out (@{$header_out_ar}) {
                my ($k, $v)=split(/\s*:\s*/, $header_out);
                $r->headers_out($k, $v);
            }
            foreach my $header_in (@{$header_in_ar}) {
                my ($k, $v)=split(/\s*:\s*/, $header_in);
                $r->headers_in($k, $v);
            }


            #  Get handler
            #
            my $handler=$opt{'handler'};


            #  Load up whichever handler we are using
            #
            (my $handler_pm = $handler) =~ s{::}{/}g;
            $handler_pm.='.pm';
            eval {require $handler_pm} ||
                return err("$Script: unable to load handler $handler, $@");


            #  Set text errors only
            #
            $WebDyne::Err::WEBDYNE_ERROR_TEXT=1 if ($opt{'error'} eq 'text');


            #  Set header, warning output
            #
            #$r->notes('noheader', $opt{'header'} ? 0 : 1);
            #$r->notes('nowarn',   $opt{'warn'} ? 0 : 1);


            #  Run it and display results, or any error generated
            #
            defined($handler->handler($r)) || return err();
            print $/;


            #  If looking for leak
            #
            #my $gladiator_ar=Devel::Gladiator::walk_arena();


            #  Manual cleanup
            #
            $r->DESTROY();


            #  Leak detection
            #
            #print("SV: ",  scalar @{$gladiator_ar}, "\n") if $opt{'leak'};
            #@{$gladiator_ar} = ();

            #  Delay (presumably to test caching code)
            #
            if (my $delay=$opt{'delay'}) {
                sleep $delay
            }

        }

        last LOOP unless $opt{'loop'};
    }


    #  Done, return success
    #
    return \0;

}


__END__