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


#
#  Dump the compiled version of WebDyne HTML scripts, as stored in the cache dir
#
use strict qw(vars);
use vars   qw($VERSION);


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


#  External modules
#
use File::Temp qw(tempfile);
use Capture::Tiny qw(capture);
use FindBin qw($Script);


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


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

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


sub main {


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


    #  Get srce file
    #
    my $srce_pn=pop(@{$argv_ar}) ||
        pod2usage("$Script: no source file specified !");


    #  Compile to first stage so WebDyne does the PSP parsing. Then run Perl
    #  syntax checks over the page code and each inline fragment.
    #
    my $perl_ar=perl_ar($srce_pn) ||
        return err();
    my (@page_perl, @chunk_perl);
    foreach my $perl_hr (@{$perl_ar}) {
        push @{$perl_hr->{'wrap'} ? \@chunk_perl : \@page_perl}, $perl_hr;
    }


    #  Check page level code first, then each inline chunk separately so one
    #  broken chunk does not hide later ones.
    #
    my $exit=0;
    my $page_exit=check_perl($srce_pn, $argv_ar, \@page_perl);
    $exit ||= $page_exit;
    foreach my $perl_hr (@chunk_perl) {
        my $chunk_exit=check_perl($srce_pn, $argv_ar, ($page_exit ? [] : \@page_perl), $perl_hr);
        $exit ||= $chunk_exit;
    }
    print "$srce_pn syntax OK\n" unless $exit;
    

    #  Done
    #
    return \$exit;


}


sub check_perl {


    #  Write a temp Perl file for a page or inline fragment and run perl -c
    #
    my ($srce_pn, $argv_ar, $page_perl_ar, $chunk_perl_hr)=@_;
    my ($temp_fh, $temp_fn)=tempfile( UNLINK=> 0);
    print $temp_fh '#!perl', $/;
    print $temp_fh 'use strict;', $/;
    print $temp_fh 'package WebDyne::Lint;', $/;
    foreach my $perl_hr (@{$page_perl_ar}) {
        print_perl($temp_fh, $srce_pn, $perl_hr);
    }
    if ($chunk_perl_hr) {
        print_perl($temp_fh, $srce_pn, $chunk_perl_hr, 1);
    }
    print $temp_fh '1;', $/;
    $temp_fh->close();


    #  Run perl check
    #
    my ($stdout, $stderr, $exit)=capture{
        system($^X, qw(-c -w), @{$argv_ar}, $temp_fn)
    };
    my $rc=$exit >> 8;
    $stderr=~s/\Q$temp_fn\E/$srce_pn/gs;
    $stderr=~s/^\Q$srce_pn\E syntax OK\r?\n//gm unless $rc;
    print $stderr;
    unlink($temp_fn);


    #  Done
    #
    return $rc;


}


sub print_perl {


    #  Print one Perl fragment into the lint temp file
    #
    my ($temp_fh, $srce_pn, $perl_hr, $wrap)=@_;
    my ($perl, $line_no)=@{$perl_hr}{qw(perl line_no)};
    if ($wrap) {
        print $temp_fh 'my $__wdlint_cr = sub {', $/;
        print $temp_fh "#line ${line_no} \"$srce_pn\"", $/;
        print $temp_fh $perl;
        print $temp_fh $/ unless $perl=~/(?:\r?\n|\r)$/;
        print $temp_fh '};', $/;
    }
    else {
        print $temp_fh "#line ${line_no} \"$srce_pn\"", $/;
        print $temp_fh $perl;
        print $temp_fh $/ unless $perl=~/(?:\r?\n|\r)$/;
    }


    #  Done
    #
    return \undef;


}


sub perl_ar {


    #  Compile file and collect Perl code fragments
    #
    my $srce_pn=shift();
    my $compile_or=WebDyne::Compile->new(filename => $srce_pn) ||
        return err();
    my $container_ar=$compile_or->compile({

        srce        => $srce_pn,
        no_perl     => 1,
        no_filter   => 1,
        no_manifest => 1,
        stage0      => 1

    }) || return err();


    #  Start with page level __PERL__ code
    #
    my @perl;
    my $meta_hr=$container_ar->[0] || {};
    my $perl_ar=$meta_hr->{'perl'} || [];
    my $perl_debug_ar=$meta_hr->{'perl_debug'} || [];
    foreach my $ix (0..$#{$perl_ar}) {
        my $perl_sr=$perl_ar->[$ix];
        my $line_no=$perl_debug_ar->[$ix][0] || 1;
        push @perl, {perl => ${$perl_sr}, line_no => $line_no};
    }


    #  Then inline Perl and substitutions from the compiled data tree
    #
    collect_perl_ar($container_ar->[1], \@perl);


    #  Done
    #
    return \@perl;


}


sub collect_perl_ar {


    #  Walk compiled data tree collecting inline Perl and substitution snippets
    #
    my ($data_xr, $perl_ar)=@_;
    return if !ref($data_xr);
    return if ref($data_xr) ne 'ARRAY';

    my ($tag, $attr_hr, $child_ar, $line_no)=@{$data_xr}[
        WEBDYNE_NODE_NAME_IX,
        WEBDYNE_NODE_ATTR_IX,
        WEBDYNE_NODE_CHLD_IX,
        WEBDYNE_NODE_LINE_IX
    ];

    if ($tag && $tag eq 'perl' && $attr_hr && $attr_hr->{'perl'}) {
        push @{$perl_ar}, {perl => $attr_hr->{'perl'}, line_no => $line_no || 1, wrap => 1};
    }

    if ($attr_hr) {
        foreach my $attr_name (sort keys %{$attr_hr}) {
            next if $attr_name eq 'perl';
            collect_subst_perl_ar($attr_hr->{$attr_name}, $line_no, $perl_ar, 1);
        }
    }

    if ($child_ar) {
        foreach my $child_xr (@{$child_ar}) {
            if (ref($child_xr)) {
                collect_perl_ar($child_xr, $perl_ar);
            }
            else {
                collect_subst_perl_ar($child_xr, $line_no, $perl_ar);
            }
        }
    }


    #  Done
    #
    return \undef;


}


sub collect_subst_perl_ar {


    #  Extract Perl snippets from WebDyne substitution strings
    #
    my ($text, $line_no, $perl_ar, $attr_fg)=@_;
    return if ref($text);

    if ($attr_fg && $text=~/^\s*([\@%!])\{(\1?)(.*)\2}\s*$/s) {
        push @{$perl_ar}, {perl => $3, line_no => $line_no || 1, wrap => 1};
    }
    else {
        while ($text=~/(!)\{(\1?)(.*?)\2\}/g) {
            push @{$perl_ar}, {perl => $3, line_no => $line_no || 1, wrap => 1};
        }
    }


    #  Done
    #
    return \undef;


}

__END__

=begin markdown

# wdlint #

# NAME #

wdlint - check Perl syntax embedded in a WebDyne file

<a name="wdlint-synopsis"></a>

# SYNOPSIS #

`wdlint [PERL_OPTIONS] FILE`

<a name="wdlint-description"></a>

# Description #

The  wdlint  command checks the Perl syntax embedded in a WebDyne  .psp  file.

It does this by compiling the page to WebDyne stage 0, collecting embedded Perl fragments, then writing those fragments to temporary Perl files with `#line` directives so syntax errors reported by Perl refer back to the original source file and line numbers as closely as possible. Inline fragments are checked separately so one syntax error does not hide later errors in other fragments.

It then runs:

```bash
perl -c -w

```

against the temporary file and prints any warnings or syntax errors returned by Perl.

This utility is primarily useful for checking server-side Perl code in `__PERL__`, inline `<perl>` blocks, processing instructions, and substitution expressions. It is not a full WebDyne page validator and it does not check runtime behaviour of the page.

<a name="wdlint-options"></a>

# Options #

wdlint  does not implement its own option parser. The last argument is treated as the source file to check. Any earlier arguments are passed directly through to Perl when running  the syntax check.

In practice this means:

*  Perl warnings are enabled by default via  -w .

*  Perl syntax checking is enabled by default via -c .

*  Any additional arguments before the file name are passed directly to Perl, for example include paths or other Perl switches.

<a name="wdlint-examples"></a>

# Examples #

```html
# Sample psp file with deliberate error, save as check.psp
#
<start_html>
Hello World <? server_time() ?>
__PERL__

sub server_time {
    my 2==1; # Error here
}
```

```bash
# Check the embedded Perl syntax in a WebDyne page
#
$ wdlint check.psp
syntax error at check.psp line 6, near "my 2"
check.psp had compilation errors.
```

```bash
# Pass an include path through to Perl while checking syntax
#
$ wdlint -I/path/to/lib page.psp
```

<a name="wdlint-notes"></a>

# Notes #

wdlint relies on WebDyne's stage 0 compiler to find embedded Perl. If a file contains no embedded Perl, the command still constructs a minimal temporary file and runs Perl syntax checking against it.

The temporary file is removed after the Perl syntax check completes.

wdlint  adds  `use strict;`  to the temporary file during checking, so code that only compiles without strict mode may fail under  wdlint .

Because the command relies on Perl's own parser, it is a good tool for catching syntax mistakes early, but it will not detect WebDyne-specific logic errors, bad HTML, or problems that only appear when the page is compiled or rendered in a real request context.

<a name="wdlint-author"></a>

# Author #

Andrew Speer <andrew.speer@isolutions.com.au>

# LICENSE and COPYRIGHT

This file is part of WebDyne.

This software is copyright (c) 2026 by Andrew Speer <andrew.speer.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/>


=end markdown


=head1 wdlint


=head1 NAME

wdlint - check Perl syntax embedded in a WebDyne file




=head1 SYNOPSIS

C<wdlint [PERL_OPTIONS] FILE>




=head1 Description

The  wdlint  command checks the Perl syntax embedded in a WebDyne  .psp  file.

It does this by compiling the page to WebDyne stage 0, collecting embedded Perl fragments, then writing those fragments to temporary Perl files with C<#line> directives so syntax errors reported by Perl refer back to the original source file and line numbers as closely as possible. Inline fragments are checked separately so one syntax error does not hide later errors in other fragments.

It then runs:


 perl -c -w

against the temporary file and prints any warnings or syntax errors returned by Perl.

This utility is primarily useful for checking server-side Perl code in C<__PERL__>, inline C<<< <perl> >>> blocks, processing instructions, and substitution expressions. It is not a full WebDyne page validator and it does not check runtime behaviour of the page.




=head1 Options

wdlint  does not implement its own option parser. The last argument is treated as the source file to check. Any earlier arguments are passed directly through to Perl when running  the syntax check.

In practice this means:

=over

=item *

Perl warnings are enabled by default via  -w .



=item *

Perl syntax checking is enabled by default via -c .



=item *

Any additional arguments before the file name are passed directly to Perl, for example include paths or other Perl switches.



=back




=head1 Examples


 # Sample psp file with deliberate error, save as check.psp
 #
 <start_html>
 Hello World <? server_time() ?>
 __PERL__
 
 sub server_time {
     my 2==1; # Error here
 }

 # Check the embedded Perl syntax in a WebDyne page
 #
 $ wdlint check.psp
 syntax error at check.psp line 6, near "my 2"
 check.psp had compilation errors.

 # Pass an include path through to Perl while checking syntax
 #
 $ wdlint -I/path/to/lib page.psp



=head1 Notes

wdlint relies on WebDyne's stage 0 compiler to find embedded Perl. If a file contains no embedded Perl, the command still constructs a minimal temporary file and runs Perl syntax checking against it.

The temporary file is removed after the Perl syntax check completes.

wdlint  adds  C<use strict;>  to the temporary file during checking, so code that only compiles without strict mode may fail under  wdlint .

Because the command relies on Perl's own parser, it is a good tool for catching syntax mistakes early, but it will not detect WebDyne-specific logic errors, bad HTML, or problems that only appear when the page is compiled or rendered in a real request context.




=head1 Author

Andrew Speer L<mailto:andrew.speer@isolutions.com.au>


=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
