view release on metacpan or  search on metacpan

lib/XML/Axk/Preparse.pm  view on Meta::CPAN

        # TODO permit the caller to say what to do with lines before the first pragma
        unless(/^\h*(#|$)/) {   # Ignore blanks and comments before the
                                # first Ln.
            die "Source text can't come before a pragma line" unless @retval;
        }
        $retval[-1]->{text} .= $_;
        #say "Stashed $_";
    }
    close $fh;

    return \@retval, $hasLang if wantarray;
    return \@retval;
} #pieces()

=head2 assemble

Assemble a script for C<eval> based on the results of a call to pieces().
Usage:

    my $srNewText = assemble($filename, $lrPieces);

=cut

sub assemble {
    my ($filename, $lrPieces) = @_ or croak("Need filename, pieces");
    croak "Need pieces as a reference" unless ref $lrPieces eq 'ARRAY';

    $filename =~ s{"}{-}g;
        # as far as I can tell, #line can't handle embedded quotes.

    my $retval = '';
    foreach my $hrPiece (@$lrPieces) {

        die "-B not yet implemented" if $hrPiece->{pragmas}->{B};

        # Which language?
        my $lang = ($hrPiece->{pragmas}->{L}->{digits} //
                    $hrPiece->{pragmas}->{L}->{name});
        unless(defined $lang) {
            $retval .= $hrPiece->{text};
            next;
        }
        my $lang_module = "XML::Axk::L::L$lang";

        # Does this language parse the source text itself?
        my $want_text;
        eval "require $lang_module";
        die "Can't find language $lang: $@" if $@;
        do {
            no strict 'refs';
            $want_text = ${"${lang_module}::C_WANT_TEXT"};
        };

        unless($want_text) {    # Easy case: the script's code is still Perl
            $retval .= "use $lang_module;\n";
            $retval .= "#line $hrPiece->{start} \"$filename\"\n";
            $retval .= $hrPiece->{text};

        } else {                # Harder case: give the Ln the source text
            my $trailer =
                "AXK_EMBEDDED_SOURCE_DO_NOT_TYPE_THIS_YOURSELF_OR_ELSE";

            $retval .=
                "use $lang_module \"$filename\", $hrPiece->{start}, " .
                "<<'$trailer';\n";
            $retval .= $hrPiece->{text};
            $retval .= "\n$trailer\n";
            # Don't need a #line because the next language will take care of it
        }
    }

    return \$retval;
} #assemble()

=head2 preparse

Invokes pieces() and assemble().  Usage:

    my $srTextOut = preparse($filename, $textIn);

C<textIn> can be a string or a string ref.

=cut

sub preparse {
    my $filename = $_[0] or croak('Need filename');
    my $srTextIn = $_[1] or croak('Need text');
    $srTextIn = \$_[1] unless ref $srTextIn eq 'SCALAR';

    my $lrPieces = pieces($srTextIn);
    my $srTextOut = assemble($filename, $lrPieces);
    return $srTextOut;
} #preparse()

1;
# vi: set ts=4 sts=4 sw=4 et ai fo-=ro foldmethod=marker: #