Skip to content

Commit a08718b

Browse files
author
Chris White
committed
Support -L command-line arg
1 parent e001b9d commit a08718b

File tree

12 files changed

+163
-78
lines changed

12 files changed

+163
-78
lines changed

‎MANIFEST‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ lib/XML/Axk/Core.pm
77
lib/XML/Axk/DOM.pm
88
lib/XML/Axk/L/L0.pm
99
lib/XML/Axk/L/L1.pm
10+
lib/XML/Axk/L/LTEST.pm
1011
lib/XML/Axk/Language.pm
1112
lib/XML/Axk/Matcher/Always.pm
1213
lib/XML/Axk/Matcher/XPath.pm
@@ -33,11 +34,11 @@ t/ex/02.axk
3334
t/ex/1.axk
3435
t/ex/2.axk
3536
t/ex/ex1.xml
36-
t/ex/l0.axk
37+
t/ex/lTEST.axk
3738
t/ex/nutrition.xml
3839
t/ex/oneliner
3940
t/ex/xml1.axk
4041
t/lib/AxkTest.pm
4142
t/lib/AxkTest/Helpers.pm
42-
t/tests/T/Object/TinyDefaults.pm
43-
t/tests/T/XML/Axk/L1.pm
43+
t/tests/L1.pm
44+
t/tests/TinyDefaults.pm

‎lib/XML/Axk/App.pm‎

Lines changed: 49 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -20,15 +20,24 @@ use constant EXIT_PARAM_ERR => 2; # couldn't understand the command line
2020

2121
# === Command line parsing ============================================== {{{1
2222

23-
# files/scripts to load, in order. Each element is [isfile, text].
24-
# Package var so we can localize it.
23+
# Files/scripts to load, in order. Each element is either [isfile, text]
24+
# or {...} for pragmas.
25+
# It is a package var so we can localize it.
2526
our @_Sources;
2627

2728
my $dr_save_source = sub {
2829
my ($which, $text) = @_;
2930
push @_Sources, [$which eq 'f', $text];
3031
}; # dr_save_source
3132

33+
my $dr_save_pragma = sub {
34+
my ($kind, $text) = @_;
35+
$kind = 'B' if $kind eq 'backend';
36+
$kind = 'L' if $kind eq 'language';
37+
38+
push @_Sources, { $kind => $text };
39+
}; # dr_save_pragma
40+
3241
my %CMDLINE_OPTS = (
3342
# hash from internal name to array reference of
3443
# [getopt-name, getopt-options, optional default-value]
@@ -37,7 +46,7 @@ my %CMDLINE_OPTS = (
3746
# They are listed in alphabetical order by option name,
3847
# lowercase before upper, although the code does not require that order.
3948

40-
#BACKEND => ['b', '|backend=s'], # TODO
49+
#BACKEND => ['b', '|backend=s', $dr_save_pragma], # TODO
4150

4251
#DUMP_VARS => ['d', '|dump-variables', false],
4352
#DEBUG => ['D','|debug', false],
@@ -50,7 +59,7 @@ my %CMDLINE_OPTS = (
5059
#INCLUDE => ['i','|include=s@'],
5160
#KEEP_GOING => ['k','|keep-going',false], #not in gawk
5261
#LIB => ['l','|load=s@'],
53-
LANGUAGE => ['L','|language=s'],
62+
LANGUAGE => ['L','|language=s', $dr_save_pragma],
5463
# --man reserved
5564
# OUTPUT_FILENAME => ['o','|output=s', ""], # conflict with gawk
5665
# OPTIMIZE => ['O','|optimize'],
@@ -162,16 +171,43 @@ sub Main {
162171
# they stick around as long as $core does.
163172

164173
my $cmd_line_idx = 0; # Number the `-e`s on the command line
165-
foreach my $lrSource (@{$opts{SOURCES}}) {
166-
my ($is_file, $text) = @$lrSource;
167-
if($is_file) {
168-
$core->load_script_file($text);
169-
} else {
170-
$core->load_script_text($text,
171-
"(cmd line script #@{[++$cmd_line_idx]})",
172-
true); # true => add a Ln if there isn't one in the script
174+
my $curr_lang = undef; # current -L, if any.
175+
#my $curr_backend = undef; # to do
176+
177+
foreach my $rItem (@{$opts{SOURCES}}) {
178+
179+
if(ref $rItem eq 'ARRAY') { # source file or text
180+
my $lrSource = $rItem;
181+
my ($is_file, $text) = @$lrSource;
182+
183+
if($is_file) {
184+
$core->load_script_file(filename => $text,
185+
$curr_lang ? (language => $curr_lang) : ()
186+
);
187+
188+
} else {
189+
$core->load_script_text(text => $text,
190+
filename => "(cmd line script #@{[++$cmd_line_idx]})",
191+
$curr_lang ? (language => $curr_lang) :
192+
(auto_language => true)
193+
# true => add a Ln if there isn't one in the script
194+
);
195+
}
196+
197+
} else { # pragma
198+
my $hrPragma = $rItem;
199+
200+
if(exists $hrPragma->{L}) {
201+
$curr_lang = $hrPragma->{L};
202+
#say "# Language is now $curr_lang"
203+
}
204+
205+
if(exists $hrPragma->{B}) {
206+
die 'Backend selection is not yet supported';
207+
}
173208
}
174-
} #foreach source
209+
210+
} #foreach source item
175211

176212
# read from stdin if no input files specified.
177213
push @$lrArgs, '-' unless @$lrArgs || $opts{NO_INPUT};

‎lib/XML/Axk/Base.pm‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ our %EXPORT_TAGS = (
3636
all => [@EXPORT, @EXPORT_OK]
3737
);
3838

39+
# Uncomment for full stacktraces on all errors
3940
BEGIN {
4041
$SIG{'__DIE__'} = sub { Carp::confess(@_) } unless $SIG{'__DIE__'};
4142
#$Exporter::Verbose=1;

‎lib/XML/Axk/Core.pm‎

Lines changed: 30 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,9 @@ my $scriptnumber = 0;
7272

7373
=head2 load_script_file
7474
75-
Load the named script file from disk, but do not execute it.
75+
Load the named script file from disk, but do not execute it. Usage:
76+
77+
$core->load_script_file(filename => $name[, ...])
7678
7779
=cut
7880

@@ -81,45 +83,59 @@ Load the named script file from disk, but do not execute it.
8183
# @param $fn {String} Filename to load
8284
sub load_script_file {
8385
my $self = shift;
86+
my %args = @_;
8487

85-
my $fn = shift;
86-
open(my $fh, '<', $fn) or croak("Cannot open $fn");
88+
my $fn = $args{filename} or croak 'Need a filename';
89+
open(my $fh, '<', $fn) or croak "Cannot open $fn";
8790
my $contents = do { local $/; <$fh> };
8891
close $fh;
8992

90-
$self->load_script_text($contents, $fn, false);
93+
$self->load_script_text(text => $contents, filename => $fn,
94+
auto_language => false);
9195
# false => scripts on disk MUST specify a Ln directive. This is a
92-
# design decision, so we don't have issues like Perl 5/6 or Python 2/3.
96+
# design decision, so we don't have issues like Python 2/3.
9397

9498
} #load_script_file
9599

96100
=head2 load_script_text
97101
98-
Load the given text, but do not execute it.
102+
Load the given text, but do not execute it. Usage:
103+
104+
$core->load_script_text(text => $text[, filename => $name][, ...])
99105
100106
=cut
101107

102108
# TODO permit specifying a specific Ln?
103109
# @param $self
104110
# @param $text {String} The source text, **which load_script_text may modify.**
105-
# @param $fn {String} Filename to use in debugging messages
106-
# @param $add_Ln {boolean, default false} If true, add a Ln directive for the
111+
# @param $filename {String} Filename to use in debugging messages
112+
# @param $auto_language {boolean, default false} If true, add a Ln directive for the
107113
# current version if there isn't one in the script.
114+
# @param $language {String} If provided, the language to use for the first
115+
# chunk of the text.
108116
sub load_script_text {
109117
my $self = shift;
110-
my $text = shift;
111-
my $fn = shift // '(command line)';
112-
my $add_Ln = shift;
118+
my %args = @_;
119+
120+
my $text = $args{text} or croak 'Need script text';
121+
my $fn = $args{filename} // '(anonymous)';
122+
123+
my $curr_lang = $args{language};
124+
my $add_Ln = $args{auto_language};
125+
croak 'language and auto_language are mutually exclusive' if $curr_lang && $add_Ln;
113126

114127
# Text to wrap around the script
115128
my ($leader, $trailer) = ('', '');
116129

117130
#say "Text is $text";
118-
my ($lrPieces, $has_lang) = XML::Axk::Preparse::pieces(\$text,
119-
$add_Ln ? { L => {} } : undef);
131+
my $hrInitialPragmas = {};
132+
$hrInitialPragmas = { L => {$curr_lang ? (name => '' . $curr_lang) : ()} }
133+
if $add_Ln || $curr_lang;
134+
135+
my ($lrPieces, $has_lang) = XML::Axk::Preparse::pieces(\$text, $hrInitialPragmas);
120136

121137
#say "Has lang" if $has_lang;
122-
unless($has_lang) {
138+
unless($has_lang || $curr_lang) {
123139
if($add_Ln) {
124140
$lrPieces->[0]->{pragmas}->{L}->{digits} = 1; # default language
125141
} else {

‎lib/XML/Axk/L/L0.pm‎

100755100644
Lines changed: 4 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,5 @@
1-
#!/usr/bin/env perl
2-
# XML::Axk::L::L0 - DUMMY axk language, version 0
3-
# Copyright (c) 2018 cxw42. All rights reserved. Artistic 2.
4-
# This is not a real axk language - it exists for testing.
1+
# axk L0.pm: A dummy language that fails loading. Language "0" is reserved
2+
# since "0" is falsy in Perl. Reserving this language permits using Boolean
3+
# tests instead of definedness tests.
54

6-
package XML::Axk::L::L0;
7-
use XML::Axk::Base;
8-
9-
# Config
10-
our $C_WANT_TEXT = 1;
11-
12-
# Packages we invoke by hand
13-
require XML::Axk::Language;
14-
15-
# Import ========================================================= {{{1
16-
17-
sub import {
18-
#say "update: ",ref \&update, Dumper(\&update);
19-
my $target = caller;
20-
#say "XAL0 run from $target:\n", Dumper(\@_);
21-
XML::Axk::Language->import(
22-
target => $target
23-
);
24-
my $class = shift;
25-
my ($fn, $lineno, $source_text) = @_;
26-
#say "Got source text len ", length($source_text), " at $fn:$lineno:\n-----------------\n$source_text\n-----------------";
27-
} #import()
28-
29-
#}}}1
30-
1;
31-
# vi: set ts=4 sts=4 sw=4 et ai fo-=ro foldmethod=marker fdl=1: #
5+
0; # fail loading

‎lib/XML/Axk/L/LTEST.pm‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
#!/usr/bin/env perl
2+
# XML::Axk::L::LTEST - DUMMY axk language, version 0
3+
# Copyright (c) 2018 cxw42. All rights reserved. Artistic 2.
4+
# This is not a real axk language - it exists for testing.
5+
6+
package XML::Axk::L::LTEST;
7+
use XML::Axk::Base;
8+
9+
# Config
10+
our $C_WANT_TEXT = 1;
11+
12+
# Packages we invoke by hand
13+
require XML::Axk::Language;
14+
15+
# Import ========================================================= {{{1
16+
17+
sub import {
18+
#say "update: ",ref \&update, Dumper(\&update);
19+
my $target = caller;
20+
#say "XALTEST run from $target:\n", Dumper(\@_);
21+
XML::Axk::Language->import(
22+
target => $target
23+
);
24+
my $class = shift;
25+
my ($fn, $lineno, $source_text) = @_;
26+
#say "Got source text len ", length($source_text), " at $fn:$lineno:\n-----------------\n$source_text\n-----------------";
27+
} #import()
28+
29+
#}}}1
30+
1;
31+
# vi: set ts=4 sts=4 sw=4 et ai fo-=ro foldmethod=marker fdl=1: #

‎lib/XML/Axk/Preparse.pm‎

Lines changed: 26 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,27 @@ C<-Ln> pragma at the beginning of your script or on the axk command line.
4545
This is consistent with the requirement to list the version in your source
4646
files.
4747
48+
=head2 Language formats
49+
50+
Languages can either be:
51+
52+
=over
53+
54+
=item C<[0-9]+>
55+
56+
A numeric language has leading 0s stripped from its name. E.g., C<-L012>
57+
tries to use language C<12>.
58+
59+
Languages 1-9 are reserved for axk's use.
60+
61+
=item C<[a-zA-Z][a-zA-Z0-9\.]*>
62+
63+
An alphabetic language name is used as is, except that C<.> characters are
64+
converted to C<::> module separators.
65+
66+
Language names that are all upper case, and that have no C<.> characters,
67+
are reserved for axk's use.
68+
4869
=cut
4970

5071
=head1 ROUTINES
@@ -159,19 +180,19 @@ sub assemble {
159180
$retval .= $hrPiece->{text};
160181
next;
161182
}
162-
$lang = "XML::Axk::L::L$lang";
183+
my $lang_module = "XML::Axk::L::L$lang";
163184

164185
# Does this language parse the source text itself?
165186
my $want_text;
166-
eval "require $lang";
187+
eval "require $lang_module";
167188
die "Can't find language $lang: $@" if $@;
168189
do {
169190
no strict 'refs';
170-
$want_text = ${"${lang}::C_WANT_TEXT"};
191+
$want_text = ${"${lang_module}::C_WANT_TEXT"};
171192
};
172193

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

@@ -180,7 +201,7 @@ sub assemble {
180201
"AXK_EMBEDDED_SOURCE_DO_NOT_TYPE_THIS_YOURSELF_OR_ELSE";
181202

182203
$retval .=
183-
"use $lang \"$filename\", $hrPiece->{start}, " .
204+
"use $lang_module \"$filename\", $hrPiece->{start}, " .
184205
"<<'$trailer';\n";
185206
$retval .= $hrPiece->{text};
186207
$retval .= "\n$trailer\n";

‎t/02-basic-core.t‎

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ use warnings;
66
use Test::More; # tests=>27;
77
use Capture::Tiny 'capture_stdout';
88
use File::Spec;
9+
use constant { true => !!1, false => !!0 };
910

1011
BEGIN {
1112
use_ok( 'XML::Axk::Core' ) || print "Bail out!\n";
@@ -19,7 +20,8 @@ sub localpath {
1920
# Inline script, operation at runtime ============================= {{{1
2021
{
2122
my $core = XML::Axk::Core->new();
22-
$core->load_script_text('pre_all { print 42 }','filename',1);
23+
$core->load_script_text(text => 'pre_all { print 42 }',
24+
filename => 'filename', auto_language => true);
2325

2426
my $out = capture_stdout { $core->run(); };
2527
is($out, '42', 'inline script runs');
@@ -30,7 +32,8 @@ sub localpath {
3032
{
3133
my $core = XML::Axk::Core->new();
3234
my $out = capture_stdout {
33-
$core->load_script_text('print 42','filename',1);
35+
$core->load_script_text(text => 'print 42',
36+
filename => 'filename', auto_language => true);
3437
};
3538
is($out, '42', 'inline script runs load-time statements');
3639

@@ -42,7 +45,7 @@ sub localpath {
4245
# Script on disk ================================================== {{{1
4346
{
4447
my $core = XML::Axk::Core->new();
45-
$core->load_script_file(localpath 'ex/02.axk');
48+
$core->load_script_file(filename => localpath('ex/02.axk'));
4649

4750
my $out = capture_stdout { $core->run(); };
4851
is($out, '1337', 'on-disk script runs');
@@ -52,7 +55,7 @@ sub localpath {
5255
# Script with no language indicator =============================== {{{1
5356
{
5457
my $core = XML::Axk::Core->new();
55-
eval { $core->load_script_file(localpath 'ex/02-noL.axk'); };
58+
eval { $core->load_script_file(filename => localpath('ex/02-noL.axk')); };
5659
my $err = $@;
5760
like($err, qr/No language \(Ln\) specified/, 'detects missing Ln');
5861
}

0 commit comments

Comments
 (0)