This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ExtUtils::Miniperl::writemain()'s first argument can also be a filename.
[perl5.git] / ext / ExtUtils-Miniperl / lib / ExtUtils / Miniperl.pm
CommitLineData
a78951c8 1#!./perl -w
c8935f6c 2package ExtUtils::Miniperl;
a78951c8 3use strict;
c8935f6c 4require Exporter;
d573a731 5use ExtUtils::Embed qw(xsi_header xsi_protos xsi_body);
a78951c8
NC
6
7use vars qw($VERSION @ISA @EXPORT);
8
c8935f6c 9@ISA = qw(Exporter);
a78951c8
NC
10@EXPORT = qw(writemain);
11$VERSION = 1;
12
a06cd52b
NC
13# blead will run this with miniperl, hence we can't use autodie or File::Temp
14my $temp;
15
16END {
17 return if !defined $temp || !-e $temp;
18 unlink $temp or warn "Can't unlink '$temp': $!";
19}
20
a78951c8 21sub writemain{
a06cd52b
NC
22 my ($fh, $real);
23
24 if (ref $_[0] eq 'SCALAR') {
25 $real = ${+shift};
26 $temp = $real;
27 $temp =~ s/(?:.c)?\z/.new/;
28 open $fh, '>', $temp
29 or die "Can't open '$temp' for writing: $!";
30 } elsif (ref $_[0]) {
a78951c8
NC
31 $fh = shift;
32 } else {
33 $fh = \*STDOUT;
34 }
35
36 my(@exts) = @_;
c8935f6c 37
d573a731 38 printf $fh <<'EOF!HEAD', xsi_header();
c8935f6c
NC
39/* miniperlmain.c
40 *
41 * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
42 * 2004, 2005, 2006, 2007, by Larry Wall and others
43 *
44 * You may distribute under the terms of either the GNU General Public
45 * License or the Artistic License, as specified in the README file.
46 *
47 */
48
49/*
50 * The Road goes ever on and on
51 * Down from the door where it began.
52 *
53 * [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
54 * [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"]
55 */
56
57/* This file contains the main() function for the perl interpreter.
58 * Note that miniperlmain.c contains main() for the 'miniperl' binary,
59 * while perlmain.c contains main() for the 'perl' binary.
60 *
61 * Miniperl is like perl except that it does not support dynamic loading,
62 * and in fact is used to build the dynamic modules needed for the 'real'
63 * perl executable.
64 */
65
66#ifdef OEMVS
67#ifdef MYMALLOC
68/* sbrk is limited to first heap segment so make it big */
69#pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
70#else
71#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
72#endif
73#endif
74
c8935f6c 75#define PERL_IN_MINIPERLMAIN_C
d573a731 76%s
c8935f6c
NC
77static void xs_init (pTHX);
78static PerlInterpreter *my_perl;
79
80#if defined(PERL_GLOBAL_STRUCT_PRIVATE)
81/* The static struct perl_vars* may seem counterproductive since the
82 * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note
83 * that this static is not in the shared perl library, the globals PL_Vars
84 * and PL_VarsPtr will stay away. */
85static struct perl_vars* my_plvarsp;
86struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
87#endif
88
89#ifdef NO_ENV_ARRAY_IN_MAIN
90extern char **environ;
91int
92main(int argc, char **argv)
93#else
94int
95main(int argc, char **argv, char **env)
96#endif
97{
98 dVAR;
99 int exitstatus, i;
100#ifdef PERL_GLOBAL_STRUCT
101 struct perl_vars *plvarsp = init_global_struct();
102# ifdef PERL_GLOBAL_STRUCT_PRIVATE
103 my_vars = my_plvarsp = plvarsp;
104# endif
105#endif /* PERL_GLOBAL_STRUCT */
106#ifndef NO_ENV_ARRAY_IN_MAIN
107 PERL_UNUSED_ARG(env);
108#endif
109#ifndef PERL_USE_SAFE_PUTENV
110 PL_use_safe_putenv = FALSE;
111#endif /* PERL_USE_SAFE_PUTENV */
112
113 /* if user wants control of gprof profiling off by default */
114 /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
115 PERL_GPROF_MONCONTROL(0);
116
117#ifdef NO_ENV_ARRAY_IN_MAIN
118 PERL_SYS_INIT3(&argc,&argv,&environ);
119#else
120 PERL_SYS_INIT3(&argc,&argv,&env);
121#endif
122
123#if defined(USE_ITHREADS)
124 /* XXX Ideally, this should really be happening in perl_alloc() or
125 * perl_construct() to keep libperl.a transparently fork()-safe.
126 * It is currently done here only because Apache/mod_perl have
127 * problems due to lack of a call to cancel pthread_atfork()
128 * handlers when shared objects that contain the handlers may
129 * be dlclose()d. This forces applications that embed perl to
130 * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
131 * been called at least once before in the current process.
132 * --GSAR 2001-07-20 */
133 PTHREAD_ATFORK(Perl_atfork_lock,
134 Perl_atfork_unlock,
135 Perl_atfork_unlock);
136#endif
137
138 if (!PL_do_undump) {
139 my_perl = perl_alloc();
140 if (!my_perl)
141 exit(1);
142 perl_construct(my_perl);
143 PL_perl_destruct_level = 0;
144 }
145 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
146 exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
147 if (!exitstatus)
148 perl_run(my_perl);
149
150#ifndef PERL_MICRO
151 /* Unregister our signal handler before destroying my_perl */
152 for (i = 1; PL_sig_name[i]; i++) {
153 if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) {
154 rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL);
155 }
156 }
157#endif
158
159 exitstatus = perl_destruct(my_perl);
160
161 perl_free(my_perl);
162
163#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN)
164 /*
165 * The old environment may have been freed by perl_free()
166 * when PERL_TRACK_MEMPOOL is defined, but without having
167 * been restored by perl_destruct() before (this is only
168 * done if destruct_level > 0).
169 *
170 * It is important to have a valid environment for atexit()
171 * routines that are eventually called.
172 */
173 environ = env;
174#endif
175
176 PERL_SYS_TERM();
177
178#ifdef PERL_GLOBAL_STRUCT
179 free_global_struct(plvarsp);
180#endif /* PERL_GLOBAL_STRUCT */
181
182 exit(exitstatus);
183 return exitstatus;
184}
185
186/* Register any extra external extensions */
187
188EOF!HEAD
c8935f6c 189
d573a731 190 print $fh xsi_protos(@exts), <<'EOT', xsi_body(@exts), "}\n";
c8935f6c 191
a78951c8
NC
192static void
193xs_init(pTHX)
194{
195EOT
a06cd52b
NC
196
197 if ($real) {
198 close $fh or die "Can't close '$temp': $!";
199 rename $temp, $real or die "Can't rename '$temp' to '$real': $!";
200 }
c8935f6c
NC
201}
202
2031;
204__END__
205
206=head1 NAME
207
a78951c8 208ExtUtils::Miniperl - write the C code for perlmain.c
c8935f6c
NC
209
210=head1 SYNOPSIS
211
a78951c8
NC
212 use ExtUtils::Miniperl;
213 writemain(@directories);
214 # or
215 writemain($fh, @directories);
a06cd52b
NC
216 # or
217 writemain(\$filename, @directories);
c8935f6c
NC
218
219=head1 DESCRIPTION
220
a78951c8 221C<writemain()> takes an argument list of directories containing archive
c8935f6c 222libraries that relate to perl modules and should be linked into a new
a78951c8 223perl binary. It writes a corresponding F<perlmain.c> file that
c8935f6c 224is a plain C file containing all the bootstrap code to make the
a06cd52b
NC
225If the first argument to C<writemain()> is a reference to a scalar it is
226used as the filename to open for ouput. Any other reference is used as
227the filehandle to write to. Otherwise output defaults to C<STDOUT>.
c8935f6c
NC
228
229The typical usage is from within a Makefile generated by
a78951c8 230L<ExtUtils::MakeMaker>. So under normal circumstances you won't have to
c8935f6c
NC
231deal with this module directly.
232
233=head1 SEE ALSO
234
235L<ExtUtils::MakeMaker>
236
237=cut
47be8fd0
NC
238
239# Local variables:
240# c-indentation-style: bsd
241# c-basic-offset: 4
242# indent-tabs-mode: nil
243# End:
244#
245# ex: set ts=8 sts=4 sw=4 et: