line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Decl::Semantics;
|
2
|
|
|
|
|
|
|
|
3
|
12
|
|
|
12
|
|
72
|
use warnings;
|
|
12
|
|
|
|
|
20
|
|
|
12
|
|
|
|
|
427
|
|
4
|
12
|
|
|
12
|
|
69
|
use strict;
|
|
12
|
|
|
|
|
21
|
|
|
12
|
|
|
|
|
377
|
|
5
|
|
|
|
|
|
|
|
6
|
12
|
|
|
12
|
|
59
|
use Data::Dumper;
|
|
12
|
|
|
|
|
18
|
|
|
12
|
|
|
|
|
704
|
|
7
|
12
|
|
|
12
|
|
84
|
use File::Spec;
|
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
9959
|
|
8
|
|
|
|
|
|
|
#use Decl; This use is actually done via eval down below, but preserved here for documentation.
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Decl::Semantics - provides the framework for a set of semantic classes in a declarative framework.
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 VERSION
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Version 0.01
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '0.01';
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
Everything in C is declared using tags, and some of those tags are standard with the distribution.
|
26
|
|
|
|
|
|
|
A set of tags is called a "semantic domain", and the standard set is called the "core semantics". The core semantics
|
27
|
|
|
|
|
|
|
contain a I of stuff you might not consider core, like database functionality, but the basic rule is that if I
|
28
|
|
|
|
|
|
|
use something a lot, and I want specific support for it in the core code, it kind of needs to be in the core semantics.
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
This particular module (C) is a kind of template for other semantic domains, but it really
|
31
|
|
|
|
|
|
|
doesn't do a lot except define how standard domains scan for their own tag definitions. Other semantic domains define
|
32
|
|
|
|
|
|
|
useful utility code that can be used by tags and code working with them, but since the core domain is the language itself,
|
33
|
|
|
|
|
|
|
there's nothing additional it needs to do.
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
So this is where I'm putting the tutorial, because to be absolutely honest, I can't get .pod files to link right on CPAN.
|
36
|
|
|
|
|
|
|
Once you start reading, you'll see that this is clearly a work in progress. If you have questions or suggestions, drop
|
37
|
|
|
|
|
|
|
me a line at the email at the end of this file.
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 HOW TO USE DECL
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head2 How to call a Decl program
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Before we get down to brass tacks of what a Decl program looks like, you'll probably want to know how to set one up
|
44
|
|
|
|
|
|
|
in the first place. As usual with Perl, there's more than one right way to do it.
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
The simplest is to invoke Decl as a source filter in a normal Perl program:
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
use Decl;
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
value count "0"
|
51
|
|
|
|
|
|
|
sub increment {
|
52
|
|
|
|
|
|
|
$^count ++;
|
53
|
|
|
|
|
|
|
}
|
54
|
|
|
|
|
|
|
do {
|
55
|
|
|
|
|
|
|
increment();
|
56
|
|
|
|
|
|
|
print "$^count\n";
|
57
|
|
|
|
|
|
|
}
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
(Ignore the blatant weirdness in that code for the moment; this is just a taste.)
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
If you need more control over the Perl, you can invoke Decl without the source filter.
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
use Decl qw(-nofilter);
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
$tree = Decl->new(<
|
66
|
|
|
|
|
|
|
! value count "0"
|
67
|
|
|
|
|
|
|
! sub increment {
|
68
|
|
|
|
|
|
|
! ...
|
69
|
|
|
|
|
|
|
EOF
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
$tree->start();
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
The initial bangs aren't required, of course; they just make it easier to see where the declarative code is.
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
If you don't want to mess with significant indentation, you can do the whole thing with arrayrefs: (TODO: test this with coderefs)
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
use Decl qw(-nofilter);
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$tree = Decl->new([['value count "0"'], [sub increment {...}]]);
|
80
|
|
|
|
|
|
|
$tree->start();
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
If you're using one or more semantic domains, the same things apply (see L for examples of invocation).
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
On Windows, you can define .dpl (say) as a declarative Perl extension, and then you don't even need to use Decl.
|
85
|
|
|
|
|
|
|
(I do that myself; eventually I should build it into the installation.)
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 The structure of a Decl program
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Declarative Perl is built of nodes. Each node consists of a first line and an optional body; the body is either bracketed, in which
|
90
|
|
|
|
|
|
|
case it's executable code (Perl), or not bracketed, in which case it must be indented and the node will decide what to do with it. By
|
91
|
|
|
|
|
|
|
default, the body will itself consist of a series of nodes.
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
The first line consists of a tag, zero or more names, parameters in parentheses, options in square brackets, a label in quotes, and an
|
94
|
|
|
|
|
|
|
optional parser label to define what to do with the code block, if any, but right now the parser is ignored. (Eventually I'll put in
|
95
|
|
|
|
|
|
|
L and you'll be able to go crazy defining code in any language you like, which will actually be pretty darned cool.)
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
The code in a bracketed body has no significant indentation; it's just Perl (or whatever, eventually - meaning that if it's Python it
|
98
|
|
|
|
|
|
|
I have significant indentation, but that sort of clouds the issue, so pretend you didn't just read it).
|
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head2 Order of execution
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
The overall execution of a Decl program has two phases, the build phase and the run phase. During the build phase, tags are parsed
|
103
|
|
|
|
|
|
|
in a depth-first order and their active structure, if any, is built at the same time. (For instance, a database connection is created
|
104
|
|
|
|
|
|
|
as soon as the database tag is parsed.) Once everything is built, the run phase starts, consisting of the top-level node trying to
|
105
|
|
|
|
|
|
|
run each of its children in order (and each node its own children, again depth-first), with one caveat. Some tags are declarative only,
|
106
|
|
|
|
|
|
|
and so do not run. Some tags are code, and so always run. And some tags are ambivalent. It's the ambivalent ones that have the caveat:
|
107
|
|
|
|
|
|
|
if an ambivalent tag is the I in its enclosing node (or the program as a whole), it will run; otherwise, it will consider itself
|
108
|
|
|
|
|
|
|
declarative and it won't run.
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
This is to permit a default behavior that makes sense if no explicit code is included, while still providing an easy way to override it.
|
111
|
|
|
|
|
|
|
The prime example is L - if the Word document stands alone in its program, it will "run" by writing the file it
|
112
|
|
|
|
|
|
|
defines or by executing the actions defined within it. But if there is code I it, that code is considered to be the definitive action
|
113
|
|
|
|
|
|
|
of the program, so the Word file structure will simply be taken as descriptive.
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Code that appears I such a tag is assumed to be setup code that prepares whatever the native action of the ambivalent tag in question
|
116
|
|
|
|
|
|
|
will be, perhaps doing a calculation whose result will appear in the text of the Word file defined.
|
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head2 Embedding Perl
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Every Decl program is, of course, a Perl program. It's just more succinct. But at nearly every point along
|
121
|
|
|
|
|
|
|
the way, it's possible to drop down into Perl and do things by hand if the Decl framework doesn't give you enough functionality.
|
122
|
|
|
|
|
|
|
And of course, any but the most trivial things will require this.
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
The thing to remember is that the 'do' tag always defines a callable action. The 'sub' tag defines a subroutine for later use, just like you'd
|
125
|
|
|
|
|
|
|
think. The 'on' tag defines an I, which is essentially a simple command in the enclosing event context. It's most commonly used for
|
126
|
|
|
|
|
|
|
user interface programming, so if you're doing, say, reporting, you might never even see an event.
|
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 The event context in embedded Perl
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Every piece of Perl code in a Decl program runs in a "context" consisting of its parent object or some ancestor of the parent.
|
131
|
|
|
|
|
|
|
Tags know whether they're event contexts or not, and so if you ask a given tag for its context, it will respond either with a pointer
|
132
|
|
|
|
|
|
|
to itself, or to a pointer to its parent's event context.
|
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
The reason I started calling this an event context is because I was using it to model the parts of a Wx GUI program that handle events;
|
135
|
|
|
|
|
|
|
a button on a form has an event associated with it, but the event runs in the context of the form, so the form is the event context.
|
136
|
|
|
|
|
|
|
But once I had something like a context to hang things on, I ended up adding variables and functions to them as well. So now they're
|
137
|
|
|
|
|
|
|
really more than just "event contexts", but the word "context" is too broad - so they're event contexts.
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 Syntactic sugar when embedding Perl
|
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
My main reason for writing Decl is to save typing and repetition. The declarative structure itself replaces reams of setup code,
|
142
|
|
|
|
|
|
|
but there are lots of shorthand abbreviations I like to use in embedded Perl snippets as well.
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head2 Magic variables
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
An event context has a hashref that contains named values for the context. However, you can also define getters and setters for those
|
147
|
|
|
|
|
|
|
values that do more than just get and set values. I call these "magic variables". The tastiest application of magic variables is to
|
148
|
|
|
|
|
|
|
bind named values to the text in input fields on a form. Now you can get and set those values and Decl (actually Wx::Decl) will
|
149
|
|
|
|
|
|
|
automatically forward that to the input fields themselves. This allows a I of succinctness:
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
use Wx::Declarative;
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
dialog (xsize=250, ysize=110) "Wx::Declarative dialog sample"
|
154
|
|
|
|
|
|
|
field celsius (size=100, x=20, y=20) "0"
|
155
|
|
|
|
|
|
|
button celsius (x=130, y=20) "Celsius" { $^fahrenheit = ($^celsius / 100.0) * 180 + 32; }
|
156
|
|
|
|
|
|
|
field fahrenheit (size=100, x=20, y=50) "32"
|
157
|
|
|
|
|
|
|
button fahrenheit (x=130, y=50) "Fahrenheit" { $^celsius = (($^fahrenheit - 32) / 180.0) * 100; }
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Here, defining the fields "celsius" and "fahrenheit" automatically defines magic variables of the same names. Magic variables have
|
160
|
|
|
|
|
|
|
syntactic sugar for access, so they're C<$^celsius> and C<$^fahrenheit> respectively. This is one of my favorite examples because
|
161
|
|
|
|
|
|
|
(1) it works, (2) it's the reason I started down this path in the first place, and (3) it replaces about 80 lines of vanilla Perl setup
|
162
|
|
|
|
|
|
|
code.
|
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head2 Iterators
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
There is syntactic sugar available for iterators. An iterator is defined by any text in the tree, by a 'data' tag, or by queries against
|
167
|
|
|
|
|
|
|
databases.
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
TODO: Iterator examples
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head2 Databases
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
C includes C access for the simple reason that - while I love DBI like I love my own children - I hate
|
174
|
|
|
|
|
|
|
all the additional code needed to query a database. I can never remember it, and that's my primary criterion for what is
|
175
|
|
|
|
|
|
|
a good candidate for declaratization.
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
The simplest way to query a database is just this:
|
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
database (msaccess) "c:/translation/jobs2002.mdb"
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
do {
|
182
|
|
|
|
|
|
|
^select due, words, customer, desc from [open jobs] {{
|
183
|
|
|
|
|
|
|
print "-------------------\n";
|
184
|
|
|
|
|
|
|
print "due: $due\n";
|
185
|
|
|
|
|
|
|
print "words: $words\n";
|
186
|
|
|
|
|
|
|
print "customer: $customer\n";
|
187
|
|
|
|
|
|
|
print "desc: $desc\n";
|
188
|
|
|
|
|
|
|
}}
|
189
|
|
|
|
|
|
|
}
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Well, I lie. The I way to query a database is more like this:
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
database (msaccess) "c:/translation/jobs2002.mdb"
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
do {
|
196
|
|
|
|
|
|
|
use Data::Dumper;
|
197
|
|
|
|
|
|
|
^select * from [open jobs] {{ print Dumper($row); }}
|
198
|
|
|
|
|
|
|
}
|
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
The C<^select> construct is code-generation magic; note that it requires double brackets {{ }} to delineate its loop, just like other
|
201
|
|
|
|
|
|
|
iterators. This is because it is actually a block with 'my' variables enclosing a loop; the closing }} terminates both the block and
|
202
|
|
|
|
|
|
|
the loop explicitly, while you should think of the opening {{ as containing all the 'my' variables.
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
If your select statement has a *, then the 'my' variables will be C<$dbh>, C<$sth>, and C<$row>, where C<$row> is a hashref with the
|
205
|
|
|
|
|
|
|
results of the current row. If you explicitly name variables, then they will all be declared as 'my' variables, and C<$sth->bind_columns>
|
206
|
|
|
|
|
|
|
will be used to bind them to the current row results. This is the fastest way to extract information from C, so it's highly
|
207
|
|
|
|
|
|
|
recommended - but as you know, the point of C is to be fast to I and I; optimization will be left as
|
208
|
|
|
|
|
|
|
an exercise for the reader.
|
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
It's important to understand that the C tag represents the database connection. It's established during the build phase, and you
|
211
|
|
|
|
|
|
|
can reach it easily from Perl code like this:
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
database (msaccess) "c:/translation/jobs2002.mdb"
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
do {
|
216
|
|
|
|
|
|
|
my $dbh = ^('database')->dbh;
|
217
|
|
|
|
|
|
|
$dbh->table_info(...);
|
218
|
|
|
|
|
|
|
}
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Everything that L exposes is thus available to you as well; you just don't have to set it all up.
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Since the database connection is established at build time, you can also use it at build time with the 'select' tag to build structure that
|
223
|
|
|
|
|
|
|
depends on database input. Here's an example with a Word document used as a report:
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
use Win32::Word::Declarative;
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
database (msaccess) "jobs2002.mdb"
|
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
document "invoice_report.doc"
|
230
|
|
|
|
|
|
|
para (align=center, size=16, bold) "Customers to invoice"
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
table
|
233
|
|
|
|
|
|
|
column (align=center)
|
234
|
|
|
|
|
|
|
column (align=center)
|
235
|
|
|
|
|
|
|
row (bold)
|
236
|
|
|
|
|
|
|
cell "Customer"
|
237
|
|
|
|
|
|
|
row (bold)
|
238
|
|
|
|
|
|
|
cell "Amount"
|
239
|
|
|
|
|
|
|
select customer, sum(value) as total from [jobs to invoice] group by customer order by total desc
|
240
|
|
|
|
|
|
|
row
|
241
|
|
|
|
|
|
|
cell "$customer"
|
242
|
|
|
|
|
|
|
cell "\$$total"
|
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Just try I as succinctly with any vanilla imperative language!
|
245
|
|
|
|
|
|
|
You could do the same with a PDF, except that PDF doesn't support tables so conveniently, and I haven't yet written code to format them.
|
246
|
|
|
|
|
|
|
Not to mention that PDF::Declarative hasn't been published yet, but hey. (TODO: revisit this paragraph when appropriate.)
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=head2 Templates
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=head1 WHAT DECL STILL DOESN'T DO WELL
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Error handling, especially. Generally, errors are still handled with croak or die, and in a GUI environment that's really not appropriate.
|
255
|
|
|
|
|
|
|
Some errors are just ignored, and that's not appropriate anywhere.
|
256
|
|
|
|
|
|
|
This alone makes Decl not quite ready for primetime. I wouldn't mind tips and pointers if you're interested.
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head1 INTERNALS
|
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
If you're just wanting to use C, you can probably stop reading now.
|
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=head2 new(), tag()
|
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
A semantic class is just a collection of utilities for its plugins. The core Semantics class doesn't really have anything at all - but as other
|
265
|
|
|
|
|
|
|
semantic classes will subclass this, your mileage will vary. The one thing we know is that we'll want to keep track of the root.
|
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
The tag used to identify a semantic class will differ for each semantic class. It's used to register the class in the root object.
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=cut
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub new {
|
272
|
27
|
|
|
27
|
1
|
65
|
my ($class, $root) = @_;
|
273
|
|
|
|
|
|
|
|
274
|
27
|
|
|
|
|
160
|
bless { root => $root }, $class;
|
275
|
|
|
|
|
|
|
}
|
276
|
237
|
|
|
237
|
1
|
1501
|
sub tag { 'core' }
|
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head2 node
|
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
The C function creates a new node by handing things off to L. It's not too useful in the core semantics, but of
|
281
|
|
|
|
|
|
|
course it's inherited by the other semantic domains, where it can come in rather handy.
|
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=cut
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
sub node {
|
286
|
0
|
|
|
0
|
1
|
0
|
my $self = shift;
|
287
|
0
|
|
|
|
|
0
|
require Decl;
|
288
|
0
|
|
|
|
|
0
|
Decl->new(@_);
|
289
|
|
|
|
|
|
|
}
|
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=head2 import, scan_plugins, file_root, our_flags
|
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
The C function is called when the package is imported. It checks for submodules (i.e. plugins) and calls their "defines" methods
|
294
|
|
|
|
|
|
|
to ask them what tag they claim to implement. Then it gives that back to C. Most of the work is done in C,
|
295
|
|
|
|
|
|
|
because C I to execute in any subclass module so we can scan the right directory for plugins.
|
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
The C, C, and C methods are all ways of managing subclasses that require independent existence.
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=cut
|
300
|
|
|
|
|
|
|
sub import
|
301
|
|
|
|
|
|
|
{
|
302
|
12
|
|
|
12
|
|
32
|
my($type, @arguments) = @_;
|
303
|
12
|
|
|
|
|
34
|
foreach (@arguments) {
|
304
|
0
|
|
|
|
|
0
|
$type->flags()->{$_} = 1;
|
305
|
|
|
|
|
|
|
}
|
306
|
|
|
|
|
|
|
|
307
|
12
|
|
|
|
|
33
|
my $caller = caller(); # Because caller() acts *weird* in list context! Perl is so funky.
|
308
|
12
|
50
|
|
|
|
175
|
if ($caller->can('yes_i_am_declarative')) {
|
309
|
12
|
|
|
|
|
44
|
$type->scan_plugins ($caller, $type->file_root());
|
310
|
12
|
|
|
|
|
408
|
push @Decl::semantic_classes, $type;
|
311
|
|
|
|
|
|
|
} else {
|
312
|
0
|
0
|
0
|
|
|
0
|
if (@arguments and $arguments[0] eq '-nofilter') {
|
313
|
0
|
|
|
|
|
0
|
eval "use Decl qw(-nofilter $type);";
|
314
|
|
|
|
|
|
|
} else {
|
315
|
0
|
|
|
|
|
0
|
eval "use Decl qw($type);";
|
316
|
|
|
|
|
|
|
}
|
317
|
|
|
|
|
|
|
}
|
318
|
|
|
|
|
|
|
}
|
319
|
12
|
|
|
12
|
1
|
46
|
sub file_root { __FILE__ }
|
320
|
|
|
|
|
|
|
our $flags = {};
|
321
|
0
|
|
|
0
|
1
|
0
|
sub our_flags { $flags }
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub scan_plugins {
|
324
|
12
|
|
|
12
|
1
|
26
|
my ($type, $caller, $file) = @_;
|
325
|
|
|
|
|
|
|
|
326
|
12
|
50
|
|
|
|
45
|
$caller = "Decl" unless $caller;
|
327
|
12
|
|
|
12
|
|
78
|
eval "use Decl;"; # We do this to ensure C::D doesn't get called until it's really needed (instead of a regular use up top).
|
|
12
|
|
|
|
|
20
|
|
|
12
|
|
|
|
|
81
|
|
|
12
|
|
|
|
|
534
|
|
328
|
12
|
|
|
|
|
636
|
my $directory = File::Spec->rel2abs($file);
|
329
|
12
|
|
|
|
|
67
|
$directory =~ s/\.pm$//;
|
330
|
12
|
50
|
|
|
|
710
|
opendir D, $directory or warn $!;
|
331
|
12
|
|
|
|
|
605
|
foreach my $d (grep /\.pm$/, readdir D) {
|
332
|
156
|
|
|
|
|
1185
|
$d =~ s/\.pm$//;
|
333
|
156
|
|
|
|
|
784
|
my $mod = $type . "::" . $d;
|
334
|
156
|
|
|
|
|
657
|
$mod =~ /(.*)/;
|
335
|
156
|
|
|
|
|
426
|
$mod = $1;
|
336
|
12
|
|
|
12
|
|
5185
|
eval "use $mod;";
|
|
12
|
|
|
12
|
|
32
|
|
|
12
|
|
|
12
|
|
314
|
|
|
12
|
|
|
12
|
|
7604
|
|
|
12
|
|
|
12
|
|
46
|
|
|
12
|
|
|
12
|
|
312
|
|
|
12
|
|
|
12
|
|
7578
|
|
|
12
|
|
|
12
|
|
31
|
|
|
12
|
|
|
12
|
|
229
|
|
|
12
|
|
|
12
|
|
8368
|
|
|
12
|
|
|
12
|
|
38
|
|
|
12
|
|
|
12
|
|
223
|
|
|
12
|
|
|
12
|
|
6974
|
|
|
12
|
|
|
|
|
38
|
|
|
12
|
|
|
|
|
215
|
|
|
12
|
|
|
|
|
7014
|
|
|
12
|
|
|
|
|
36
|
|
|
12
|
|
|
|
|
207
|
|
|
12
|
|
|
|
|
7597
|
|
|
12
|
|
|
|
|
32
|
|
|
12
|
|
|
|
|
194
|
|
|
12
|
|
|
|
|
127
|
|
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
261
|
|
|
12
|
|
|
|
|
7674
|
|
|
12
|
|
|
|
|
36
|
|
|
12
|
|
|
|
|
203
|
|
|
12
|
|
|
|
|
7108
|
|
|
12
|
|
|
|
|
35
|
|
|
12
|
|
|
|
|
218
|
|
|
12
|
|
|
|
|
6690
|
|
|
12
|
|
|
|
|
42
|
|
|
12
|
|
|
|
|
193
|
|
|
12
|
|
|
|
|
7513
|
|
|
12
|
|
|
|
|
44
|
|
|
12
|
|
|
|
|
304
|
|
|
12
|
|
|
|
|
7925
|
|
|
12
|
|
|
|
|
39
|
|
|
12
|
|
|
|
|
196
|
|
|
156
|
|
|
|
|
15382
|
|
337
|
156
|
50
|
|
|
|
825
|
if ($@) {
|
338
|
0
|
|
|
|
|
0
|
warn $@;
|
339
|
|
|
|
|
|
|
# TODO: Also do something smarter...
|
340
|
0
|
|
|
|
|
0
|
next;
|
341
|
|
|
|
|
|
|
}
|
342
|
156
|
|
|
|
|
299
|
my $tags;
|
343
|
156
|
50
|
|
|
|
2043
|
if ($mod->can('tags_defined')) { # Just in case a non-node module sneaks in there somehow.
|
344
|
156
|
|
|
|
|
666
|
$tags = $mod->tags_defined();
|
345
|
|
|
|
|
|
|
}
|
346
|
156
|
|
|
|
|
785
|
Decl->register_builder ($mod, tag(), $tags);
|
347
|
|
|
|
|
|
|
}
|
348
|
|
|
|
|
|
|
}
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=head2 start()
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
The C function is called by the framework to start the application if this semantic class is the controlling class. This won't happen
|
353
|
|
|
|
|
|
|
too often with the core semantics (except in the unit tests) but the default behavior here is to execute each callable child of the top-level
|
354
|
|
|
|
|
|
|
application in turn.
|
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=cut
|
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub start {
|
359
|
0
|
|
|
0
|
1
|
|
my ($self) = @_;
|
360
|
0
|
|
|
|
|
|
my $return;
|
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
|
foreach ($self->{root}->nodes) {
|
363
|
0
|
0
|
|
|
|
|
next unless $_->{callable};
|
364
|
0
|
0
|
|
|
|
|
next if $_->{event};
|
365
|
0
|
|
|
|
|
|
$return = $_->go;
|
366
|
|
|
|
|
|
|
}
|
367
|
0
|
|
|
|
|
|
return $return;
|
368
|
|
|
|
|
|
|
}
|
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head2 do()
|
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Each semantic module can accept events/commands issued to its name. They are sent to the C method here, already parsed.
|
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut
|
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub do {
|
377
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
378
|
0
|
|
|
|
|
|
my $command = shift;
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
# The core module doesn't implement anything.
|
381
|
|
|
|
|
|
|
}
|
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=head1 AUTHOR
|
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
Michael Roberts, C<< >>
|
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head1 BUGS
|
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through
|
391
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll
|
392
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes.
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Copyright 2010 Michael Roberts.
|
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
399
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published
|
400
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License.
|
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information.
|
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=cut
|
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
1; # End of Decl::Semantics
|