Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Inline::Foo; |
2 | $VERSION = '0.01'; | |
3 | require Inline; | |
4 | @ISA = qw(Inline); | |
5 | use strict; | |
6 | use Carp; | |
7 | use File::Spec; | |
8 | ||
9 | sub register { | |
10 | return { | |
11 | language => 'Foo', | |
12 | aliases => ['foo'], | |
13 | type => 'interpreted', | |
14 | suffix => 'foo', | |
15 | }; | |
16 | } | |
17 | ||
18 | sub usage_config { | |
19 | my $key = shift; | |
20 | "'$key' is not a valid config option for Inline::Foo\n"; | |
21 | } | |
22 | ||
23 | sub usage_config_bar { | |
24 | "Invalid value for Inline::Foo config option BAR"; | |
25 | } | |
26 | ||
27 | sub validate { | |
28 | my $o = shift; | |
29 | $o->{ILSM}{PATTERN} ||= 'foo-'; | |
30 | $o->{ILSM}{BAR} ||= 0; | |
31 | while (@_) { | |
32 | my ($key, $value) = splice @_, 0, 2; | |
33 | if ($key eq 'PATTERN') { | |
34 | $o->{ILSM}{PATTERN} = $value; | |
35 | next; | |
36 | } | |
37 | if ($key eq 'BAR') { | |
38 | croak usage_config_bar | |
39 | unless $value =~ /^[01]$/; | |
40 | $o->{ILSM}{BAR} = $value; | |
41 | next; | |
42 | } | |
43 | croak usage_config($key); | |
44 | } | |
45 | } | |
46 | ||
47 | sub build { | |
48 | my $o = shift; | |
49 | my $code = $o->{API}{code}; | |
50 | my $pattern = $o->{ILSM}{PATTERN}; | |
51 | $code =~ s/$pattern//g; | |
52 | $code =~ s/bar-//g if $o->{ILSM}{BAR}; | |
53 | sleep 1; # imitate compile delay | |
54 | { | |
55 | package Foo::Tester; | |
56 | eval $code; | |
57 | } | |
58 | croak "Foo build failed:\n$@" if $@; | |
59 | my $path = File::Spec->catdir($o->{API}{install_lib},'auto',$o->{API}{modpname}); | |
60 | my $obj = $o->{API}{location}; | |
61 | $o->mkpath($path) unless -d $path; | |
62 | open FOO_OBJ, "> $obj" | |
63 | or croak "Can't open $obj for output\n$!"; | |
64 | print FOO_OBJ $code; | |
65 | close \*FOO_OBJ; | |
66 | } | |
67 | ||
68 | sub load { | |
69 | my $o = shift; | |
70 | my $obj = $o->{API}{location}; | |
71 | open FOO_OBJ, "< $obj" | |
72 | or croak "Can't open $obj for output\n$!"; | |
73 | my $code = join '', <FOO_OBJ>; | |
74 | close \*FOO_OBJ; | |
75 | eval "package $o->{API}{pkg};\n$code"; | |
76 | croak "Unable to load Foo module $obj:\n$@" if $@; | |
77 | } | |
78 | ||
79 | sub info { | |
80 | my $o = shift; | |
81 | } | |
82 | ||
83 | 1; | |
84 | ||
85 | __END__ |