File: eperl_perl5_sm.pl

package info (click to toggle)
wml 2.0.11-1
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 13,668 kB
  • ctags: 5,794
  • sloc: ansic: 54,590; sh: 17,145; perl: 14,812; makefile: 2,295; yacc: 445
file content (108 lines) | stat: -rw-r--r-- 3,206 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
##
##  eperl_perl5_sm.pl -- Determine newXS() calls for XS-Init function
##  Copyright (c) 1997 Ralf S. Engelschall, All Rights Reserved. 
##

use Config;

print <<'EOT'
/*
**        ____           _ 
**    ___|  _ \ ___ _ __| |
**   / _ \ |_) / _ \ '__| |
**  |  __/  __/  __/ |  | |
**   \___|_|   \___|_|  |_|
** 
**  ePerl -- Embedded Perl 5 Language
**
**  ePerl interprets an ASCII file bristled with Perl 5 program statements
**  by evaluating the Perl 5 code while passing through the plain ASCII
**  data. It can operate both as a standard Unix filter for general file
**  generation tasks and as a powerful Webserver scripting language for
**  dynamic HTML page programming. 
**
**  ======================================================================
**
**  Copyright (c) 1996,1997 Ralf S. Engelschall, All rights reserved.
**
**  This program is free software; it may be redistributed and/or modified
**  only under the terms of either the Artistic License or the GNU General
**  Public License, which may be found in the ePerl source distribution.
**  Look at the files ARTISTIC and COPYING or run ``eperl -l'' to receive
**  a built-in copy of both license files.
**
**  This program is distributed in the hope that it will be useful, but
**  WITHOUT ANY WARRANTY; without even the implied warranty of
**  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
**  Artistic License or the GNU General Public License for more details.
**
**  ======================================================================
**
**  eperl_perl5_sm.h -- Perl 5 Static Module definition 
*/
#ifndef EPERL_PERL5_SM_H
#define EPERL_PERL5_SM_H 1

EOT
;

#
#   code stolen from Perl 5.004_04's ExtUtils::Embed because
#   this module is only available in newer Perl versions.
#

sub static_ext {
    unless (scalar @Extensions) {
        # my $static_ext = $Config{static_ext};
        # $static_ext =~ s{^\s+}{};
        # @Extensions = sort split /\s+/, $static_ext;
        unshift @Extensions, qw(DynaLoader);
    }
    return @Extensions;
}
sub xsi_body {
    my(@exts) = @_;
    my($pname,@retval,%seen);
    my($dl) = &canon('/','DynaLoader');
    foreach $_ (@exts){
        my($pname) = &canon('/', $_);
        my($mname, $cname, $ccode);
        ($mname = $pname) =~ s!/!::!g;
        ($cname = $pname) =~ s!/!__!g;
        if ($pname eq $dl){
            $ccode = "newXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\\\n";
            push(@retval, $ccode) unless $seen{$ccode}++;
        } else {
            $ccode = "newXS(\"${mname}::bootstrap\", boot_${cname}, file);\\\n";
            push(@retval, $ccode) unless $seen{$ccode}++;
        }
    }
    return join '', @retval;
}
sub canon {
    my($as, @ext) = @_;
    foreach(@ext) {
       # might be X::Y or lib/auto/X/Y/Y.a
       next if s!::!/!g;
       s:^(lib|ext)/(auto/)?::;
       s:/\w+\.\w+$::;
    }
    grep(s:/:$as:, @ext) if ($as ne '/');
    return @ext;
}
@mods = ();
push(@mods, &static_ext());
@mods = grep(!$seen{$_}++, @mods);
$DEF = "#define DO_NEWXS_STATIC_MODULES \\\n";
$DEF .= &xsi_body(@mods);
$DEF =~ s|\\\n$|\n|s;
print $DEF;

print <<EOT

#endif /* EPERL_PERL5_SM_H */
/*EOF*/
EOT
;

##EOF##