Commit | Line | Data |
3fea05b9 |
1 | package Module::Install::DSL; |
2 | |
3 | use strict; |
4 | use vars qw{$VERSION $ISCORE}; |
5 | BEGIN { |
6 | $VERSION = '0.91'; |
7 | $ISCORE = 1; |
8 | *inc::Module::Install::DSL::VERSION = *VERSION; |
9 | @inc::Module::Install::DSL::ISA = __PACKAGE__; |
10 | } |
11 | |
12 | sub import { |
13 | # Read in the rest of the Makefile.PL |
14 | open 0 or die "Couldn't open $0: $!"; |
15 | my $dsl; |
16 | SCOPE: { |
17 | local $/ = undef; |
18 | $dsl = join "", <0>; |
19 | } |
20 | |
21 | # Change inc::Module::Install::DSL to the regular one. |
22 | # Remove anything before the use inc::... line. |
23 | $dsl =~ s/.*?^\s*use\s+(?:inc::)?Module::Install::DSL(\b[^;]*);\s*\n//sm; |
24 | |
25 | # Load inc::Module::Install as we would in a regular Makefile.Pl |
26 | SCOPE: { |
27 | package main; |
28 | require inc::Module::Install; |
29 | inc::Module::Install->import; |
30 | } |
31 | |
32 | # Add the ::DSL plugin to the list of packages in /inc |
33 | my $admin = $Module::Install::MAIN->{admin}; |
34 | if ( $admin ) { |
35 | my $from = $INC{"$admin->{path}/DSL.pm"}; |
36 | my $to = "$admin->{base}/$admin->{prefix}/$admin->{path}/DSL.pm"; |
37 | $admin->copy( $from => $to ); |
38 | } |
39 | |
40 | # Convert the basic syntax to code |
41 | my $code = "package main;\n\n" |
42 | . dsl2code($dsl) |
43 | . "\n\nWriteAll();\n"; |
44 | |
45 | # Execute the script |
46 | eval $code; |
47 | print STDERR "Failed to execute the generated code" if $@; |
48 | |
49 | exit(0); |
50 | } |
51 | |
52 | sub dsl2code { |
53 | my $dsl = shift; |
54 | |
55 | # Split into lines and strip blanks |
56 | my @lines = grep { /\S/ } split /[\012\015]+/, $dsl; |
57 | |
58 | # Each line represents one command |
59 | my @code = (); |
60 | foreach my $line ( @lines ) { |
61 | # Split the lines into tokens |
62 | my @tokens = split /\s+/, $line; |
63 | |
64 | # The first word is the command |
65 | my $command = shift @tokens; |
66 | my @params = (); |
67 | my @suffix = (); |
68 | while ( @tokens ) { |
69 | my $token = shift @tokens; |
70 | if ( $token eq 'if' or $token eq 'unless' ) { |
71 | # This is the beginning of a suffix |
72 | push @suffix, $token; |
73 | push @suffix, @tokens; |
74 | last; |
75 | } else { |
76 | # Convert to a string |
77 | $token =~ s/([\\\'])/\\$1/g; |
78 | push @params, "'$token'"; |
79 | } |
80 | }; |
81 | |
82 | # Merge to create the final line of code |
83 | @tokens = ( $command, @params ? join( ', ', @params ) : (), @suffix ); |
84 | push @code, join( ' ', @tokens ) . ";\n"; |
85 | } |
86 | |
87 | # Join into the complete code block |
88 | return join( '', @code ); |
89 | } |
90 | |
91 | 1; |