X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2xs.PL;h=1b4f387d707007651468d8c6e5675ff7b8c20c8c;hb=d235852b65d51c442c4a84cfa07cd04d89233033;hp=a9b882688a197711ea6feaafa6ee1902e8a5a74a;hpb=3cb4da910f036fdb687a5ae3beba6bbf54509116;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2xs.PL b/utils/h2xs.PL index a9b8826..1b4f387 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -13,9 +13,9 @@ use Cwd; # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. -$origdir = cwd; +my $origdir = cwd; chdir dirname($0); -$file = basename($0, '.PL'); +my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; open OUT,">$file" or die "Can't create $file: $!"; @@ -35,13 +35,15 @@ $Config{startperl} print OUT <<'!NO!SUBS!'; +use warnings; + =head1 NAME h2xs - convert .h C header files to Perl extensions =head1 SYNOPSIS -B [B<-ACOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]] +B [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [B<-b> compat_version] [headerfile ... [extra_libraries]] B B<-h> @@ -78,7 +80,7 @@ S> statement from the .pm file. Omits creation of the F file, and adds a HISTORY section to the POD template. -=item B<-F> +=item B<-F> I Additional flags to specify to C preprocessor when scanning header for function declarations. Should not be used without B<-x>. @@ -100,6 +102,20 @@ Omit the autogenerated stub POD section. Omit the XS portion. Used to generate templates for a module which is not XS-based. C<-c> and C<-f> are implicitly enabled. +=item B<-a> + +Generate an accessor method for each element of structs and unions. The +generated methods are named after the element name; will return the current +value of the element if called without additional arguments; and will set +the element to the supplied value (and return the new value) if called with +an additional argument. Embedded structures and unions are returned as a +pointer rather than the complete structure, to facilitate chained calls. + +These methods all apply to the Ptr type for the structure; additionally +two methods are constructed for the structure type itself, C<_to_ptr> +which returns a Ptr type pointing to the same structure, and a C +method to construct and return a new structure, initialised to zeroes. + =item B<-c> Omit C from the .xs file and corresponding specialised @@ -118,6 +134,16 @@ not found in standard include directories. Print the usage, help and version for this h2xs and exit. +=item B<-k> + +For function arguments declared as C, omit the const attribute in the +generated XS code. + +=item B<-m> + +B: for each variable declared in the header file(s), declare +a perl variable of the same name magically tied to the C variable. + =item B<-n> I Specifies a name to be used for the extension, e.g., S<-n RPC::DCE> @@ -167,6 +193,18 @@ hand-editing. Such may be objects which cannot be converted from/to a pointer (like C), pointers to functions, or arrays. See also the section on L>. +=item B<-b> I + +Generates a .pm file which is backwards compatible with the specified +perl version. + +For versions < 5.6.0, the changes are. + - no use of 'our' (uses 'use vars' instead) + - no 'use warnings' + +Specifying a compatibility version higher than the version of perl you +are using to run h2xs will have no effect. + =back =head1 EXAMPLES @@ -224,6 +262,68 @@ also the section on L>. # Same but treat SV* etc as "opaque" types h2xs -o '^[S]V \*$' -M '^av_' -xAn perl2 perl.h,proto.h +=head2 Extension based on F<.h> and F<.c> files + +Suppose that you have some C files implementing some functionality, +and the corresponding header files. How to create an extension which +makes this functionality accessable in Perl? The example below +assumes that the header files are F and +I, and you want the perl module be named as +C. If you need some preprocessor directives and/or +linking with external libraries, see the flags C<-F>, C<-L> and C<-l> +in L<"OPTIONS">. + +=over + +=item Find the directory name + +Start with a dummy run of h2xs: + + h2xs -Afn Ext::Ension + +The only purpose of this step is to create the needed directories, and +let you know the names of these directories. From the output you can +see that the directory for the extension is F. + +=item Copy C files + +Copy your header files and C files to this directory F. + +=item Create the extension + +Run h2xs, overwriting older autogenerated files: + + h2xs -Oxan Ext::Ension interface_simple.h interface_hairy.h + +h2xs looks for header files I changing to the extension +directory, so it will find your header files OK. + +=item Archive and test + +As usual, run + + cd Ext/Ension + perl Makefile.PL + make dist + make + make test + +=item Hints + +It is important to do C as early as possible. This way you +can easily merge(1) your changes to autogenerated files if you decide +to edit your C<.h> files and rerun h2xs. + +Do not forget to edit the documentation in the generated F<.pm> file. + +Consider the autogenerated files as skeletons only, you may invent +better interfaces than what h2xs could guess. + +Consider this section as a guideline only, some other options of h2xs +may better suit your needs. + +=back + =head1 ENVIRONMENT No environment variables are used. @@ -271,15 +371,15 @@ to rewrite this function as int foo(sv) - SV *addr - PREINIT: - STRLEN len; - char *s; - CODE: - s = SvPV(sv,len); - RETVAL = foo(s, len); - OUTPUT: - RETVAL + SV *addr + PREINIT: + STRLEN len; + char *s; + CODE: + s = SvPV(sv,len); + RETVAL = foo(s, len); + OUTPUT: + RETVAL or alternately @@ -305,15 +405,18 @@ See L and L for additional details. use strict; -my( $H2XS_VERSION ) = ' $Revision: 1.20 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.21 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; +my $compat_version = $]; use Getopt::Std; +use Config; -sub usage{ - warn "@_\n" if @_; - die "h2xs [-ACOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]] +sub usage { + warn "@_\n" if @_; + die <curdir(), $Config{usrinc}, (split ' ', $Config{locincpth}), '/usr/include'); } foreach my $path_h (@path_h) { $name ||= $path_h; + $module ||= do { + $name =~ s/\.h$//; + if ( $name !~ /::/ ) { + $name =~ s#^.*/##; + $name = "\u$name"; + } + $name; + }; + if( $path_h =~ s#::#/#g && $opt_n ){ warn "Nesting of headerfile ignored with -n\n"; } @@ -427,19 +567,36 @@ if( @path_h ){ $path_h =~ s/,.*$// if $opt_x; $fullpath{$path_h} = $fullpath; + # Minor trickery: we can't chdir() before we processed the headers + # (so know the name of the extension), but the header may be in the + # extension directory... + my $tmp_path_h = $path_h; + my $rel_path_h = $path_h; + my @dirs = @paths; if (not -f $path_h) { - my $tmp_path_h = $path_h; + my $found; for my $dir (@paths) { - last if -f ($path_h = File::Spec->catfile($dir, $tmp_path_h)); + $found++, last + if -f ($path_h = File::Spec->catfile($dir, $tmp_path_h)); + } + if ($found) { + $rel_path_h = $path_h; + } else { + (my $epath = $module) =~ s,::,/,g; + $epath = File::Spec->catdir('ext', $epath) if -d 'ext'; + $rel_path_h = File::Spec->catfile($epath, $tmp_path_h); + $path_h = $tmp_path_h; # Used during -x + push @dirs, $epath; } } if (!$opt_c) { - die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h ); + die "Can't find $tmp_path_h in @dirs\n" + if ( ! $opt_f && ! -f "$rel_path_h" ); # Scan the header file (we should deal with nested header files) # Record the names of simple #define constants into const_names # Function prototypes are processed below. - open(CH, "<$path_h") || die "Can't open $path_h: $!\n"; + open(CH, "<$rel_path_h") || die "Can't open $rel_path_h: $!\n"; defines: while () { if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^" \t])(.*)/) { @@ -480,17 +637,10 @@ if( @path_h ){ } -my $module = $opt_n || do { - $name =~ s/\.h$//; - if( $name !~ /::/ ){ - $name =~ s#^.*/##; - $name = "\u$name"; - } - $name; -}; my ($ext, $nested, @modparts, $modfname, $modpname); -(chdir 'ext', $ext = 'ext/') if -d 'ext'; + +$ext = chdir 'ext' ? 'ext/' : ''; if( $module =~ /::/ ){ $nested = 1; @@ -507,7 +657,8 @@ else { if ($opt_O) { warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname; -} else { +} +else { die "Won't overwrite existing $ext$modpname\n" if -e $modpname; } if( $nested ){ @@ -527,9 +678,12 @@ my $fdecls_parsed = []; my $typedef_rex; my %typedefs_pre; my %known_fnames; +my %structs; my @fnames; my @fnames_no_prefix; +my %vdecl_hash; +my @vdecls; if( ! $opt_X ){ # use XS, unless it was disabled open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; @@ -551,13 +705,33 @@ if( ! $opt_X ){ # use XS, unless it was disabled } warn "Scanning $filename for functions...\n"; $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, - 'add_cppflags' => $addflags; + 'add_cppflags' => $addflags, 'c_styles' => [qw(C++ C9X)]; $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); push @td, @{$c->get('typedefs_maybe')}; + if ($opt_a) { + my $structs = $c->get('typedef_structs'); + @structs{keys %$structs} = values %$structs; + } + + if ($opt_m) { + %vdecl_hash = %{ $c->get('vdecl_hash') }; + @vdecls = sort keys %vdecl_hash; + for (local $_ = 0; $_ < @vdecls; ++$_) { + my $var = $vdecls[$_]; + my($type, $post) = @{ $vdecl_hash{$var} }; + if (defined $post) { + warn "Can't handle variable '$type $var $post', skipping.\n"; + splice @vdecls, $_, 1; + redo; + } + $type = normalize_type($type); + $vdecl_hash{$var} = $type; + } + } unless ($tmask_all) { warn "Scanning $filename for typedefs...\n"; @@ -569,7 +743,7 @@ if( ! $opt_X ){ # use XS, unless it was disabled } } { local $" = '|'; - $typedef_rex = qr(\b(?$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n" $" = "\n\t"; warn "Writing $ext$modpname/$modfname.pm\n"; +if ( $compat_version < 5.006 ) { print PM <<"END"; package $module; +use $compat_version; use strict; END +} +else { +print PM <<"END"; +package $module; -if( $opt_X || $opt_c || $opt_A ){ - # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD - print PM <<'END'; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +use 5.006; +use strict; +use warnings; END } -else{ + +unless( $opt_X || $opt_c || $opt_A ){ # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and # will want Carp. print PM <<'END'; use Carp; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD); END } @@ -665,15 +844,25 @@ unless ($opt_A) { # no autoloader whatsoever. } } +if ( $compat_version < 5.006 ) { + if ( $opt_X || $opt_c || $opt_A ) { + print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);'; + } else { + print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);'; + } +} + # Determine @ISA. -my $myISA = '@ISA = qw(Exporter'; # We seem to always want this. +my $myISA = 'our @ISA = qw(Exporter'; # We seem to always want this. $myISA .= ' DynaLoader' unless $opt_X; # no XS $myISA .= ');'; +$myISA =~ s/^our // if $compat_version < 5.006; + print PM "\n$myISA\n\n"; -my @exported_names = (@const_names, @fnames_no_prefix); +my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls); -print PM<<"END"; +my $tmp=<<"END"; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @@ -681,19 +870,28 @@ print PM<<"END"; # This allows declaration use $module ':all'; # If you do not need this, moving things directly into \@EXPORT or \@EXPORT_OK # will save memory. -%EXPORT_TAGS = ( 'all' => [ qw( +our %EXPORT_TAGS = ( 'all' => [ qw( @exported_names ) ] ); -\@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } ); - -\@EXPORT = ( +our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } ); +our \@EXPORT = qw( + @const_names ); -\$VERSION = '$TEMPLATE_VERSION'; +our \$VERSION = '$TEMPLATE_VERSION'; END +$tmp =~ s/^our //mg if $compat_version < 5.006; +print PM $tmp; + +if (@vdecls) { + printf PM "our(@{[ join ', ', map '$'.$_, @vdecls ]});\n\n"; +} + + +$tmp = ( $compat_version < 5.006 ? "" : "our \$AUTOLOAD;" ); print PM <<"END" unless $opt_c or $opt_X; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() @@ -701,8 +899,9 @@ sub AUTOLOAD { # to the AUTOLOAD in AutoLoader. my \$constname; + $tmp (\$constname = \$AUTOLOAD) =~ s/.*:://; - croak "&$module::constant not defined" if \$constname eq 'constant'; + croak "&${module}::constant not defined" if \$constname eq 'constant'; my \$val = constant(\$constname, \@_ ? \$_[0] : 0); if (\$! != 0) { if (\$! =~ /Invalid/ || \$!{EINVAL}) { @@ -710,17 +909,18 @@ sub AUTOLOAD { goto &AutoLoader::AUTOLOAD; } else { - croak "Your vendor has not defined $module macro \$constname"; + croak "Your vendor has not defined $module macro \$constname"; } } - { no strict 'refs'; - # Next line doesn't help with older Perls; in newers: no such warnings - # local \$^W = 0; # Prototype mismatch: sub XXX vs () - if (\$] >= 5.00561) { # Fixed between 5.005_53 and 5.005_61 - *\$AUTOLOAD = sub () { \$val }; - } else { - *\$AUTOLOAD = sub { \$val }; - } + { + no strict 'refs'; + # Fixed between 5.005_53 and 5.005_61 + if (\$] >= 5.00561) { + *\$AUTOLOAD = sub () { \$val }; + } + else { + *\$AUTOLOAD = sub { \$val }; + } } goto &\$AUTOLOAD; } @@ -733,6 +933,16 @@ bootstrap $module \$VERSION; END } +# tying the variables can happen only after bootstrap +if (@vdecls) { + printf PM <))[0,6]; + $author =~ s/,.*$//; # in case of sub fields + my $domain = $Config{'mydomain'}; + $domain =~ s/^\.//; + $email = "$user\@$domain"; + }; -=over 8 - -=item $TEMPLATE_VERSION - -Original version; created by h2xs $H2XS_VERSION with options - - @ARGS - -=back +$author ||= "A. U. Thor"; +$email ||= 'a.u.thor@a.galaxy.far.far.away'; +my $revhist = ''; +$revhist = < should be removed. -EOD +# $exp_doc .= < should be removed. +# +#EOD $exp_doc .= <${email}E # -#=head1 SEE ALSO +#=head1 COPYRIGHT AND LICENSE +# +#Copyright YEAR(S) by YOUR NAME(s) # -#perl(1). +#This library is free software; you can redistribute it and/or modify +#it under the same terms as Perl itself. # #=cut END @@ -888,7 +1135,7 @@ sub td_is_struct { my $out = $struct_typedefs{$type}; return $out if defined $out; my $otype = $type; - $out = ($type =~ /^struct\b/) && !td_is_pointer($type); + $out = ($type =~ /^(struct|union)\b/) && !td_is_pointer($type); # This converts only the guys which do not have trailing part in the typedef if (not $out and $typedef_rex and $type =~ s/($typedef_rex)/$typedefs_pre{$1}/go) { @@ -950,6 +1197,7 @@ END static double constant(char *name, int len, int arg) { + errno = 0; if (strEQ(name + $offarg, "$list->[0]")) { /* $pref removed */ #ifdef $pref$list->[0] return $protect$pref$list->[0]; @@ -968,7 +1216,7 @@ END for my $n (@$list) { my $c = substr $n, $off, 1; $leading{$c} = [] unless exists $leading{$c}; - push @{$leading{$c}}, substr $n, $off + 1; + push @{$leading{$c}}, $off < length $n ? substr $n, $off + 1 : $n } if (keys(%leading) == 1) { @@ -988,6 +1236,9 @@ END static double constant$npref(char *name, int len, int arg) { +END + + print $fh <<"END" if $npref eq ''; errno = 0; END @@ -1020,7 +1271,8 @@ EOP print $fh <[1]} @$args; my @argtypes = map { normalize_type( $_->[0], 1 ) } @$args; + if ($opt_k) { + s/^\s*const\b\s*// for @argtypes; + } my @argarrays = map { $_->[4] || '' } @$args; my $numargs = @$args; if ($numargs and $argtypes[-1] eq '...') { @@ -1144,6 +1400,203 @@ EOP } } +sub print_tievar_subs { + my($fh, $name, $type) = @_; + print $fh <[0] =~ /_ANON/) { + if (defined $item->[2]) { + push @items, map [ + @$_[0, 1], "$item->[2]_$_->[2]", "$item->[2].$_->[2]", + ], @{ $structs{$item->[0]} }; + } else { + push @items, @{ $structs{$item->[0]} }; + } + } else { + my $type = normalize_type($item->[0]); + my $ttype = $structs{$type} ? normalize_type("$type *") : $type; + print $fh <<"EOF"; +$ttype +$item->[2](THIS, __value = NO_INIT) + $ptrname THIS + $type __value + PROTOTYPE: \$;\$ + CODE: + if (items > 1) + THIS->$item->[-1] = __value; + RETVAL = @{[ + $type eq $ttype ? "THIS->$item->[-1]" : "&(THIS->$item->[-1])" + ]}; + OUTPUT: + RETVAL + +EOF + } + } +} + +sub accessor_docs { + my($name, $struct) = @_; + return unless defined $struct && $name !~ /\s|_ANON/; + $name = normalize_type($name); + my $ptrname = $name . 'Ptr'; + my @items = @$struct; + my @list; + while (@items) { + my $item = shift @items; + if ($item->[0] =~ /_ANON/) { + if (defined $item->[2]) { + push @items, map [ + @$_[0, 1], "$item->[2]_$_->[2]", "$item->[2].$_->[2]", + ], @{ $structs{$item->[0]} }; + } else { + push @items, @{ $structs{$item->[0]} }; + } + } else { + push @list, $item->[2]; + } + } + my $methods = (join '(...)>, C<', @list) . '(...)'; + + my $pod = <<"EOF"; +# +#=head2 Object and class methods for C<$name>/C<$ptrname> +# +#The principal Perl representation of a C object of type C<$name> is an +#object of class C<$ptrname> which is a reference to an integer +#representation of a C pointer. To create such an object, one may use +#a combination +# +# my \$buffer = $name->new(); +# my \$obj = \$buffer->_to_ptr(); +# +#This exersizes the following two methods, and an additional class +#C<$name>, the internal representation of which is a reference to a +#packed string with the C structure. Keep in mind that \$buffer should +#better survive longer than \$obj. +# +#=over +# +#=item C<\$object_of_type_$name-E_to_ptr()> +# +#Converts an object of type C<$name> to an object of type C<$ptrname>. +# +#=item C<$name-Enew()> +# +#Creates an empty object of type C<$name>. The corresponding packed +#string is zeroed out. +# +#=item C<$methods> +# +#return the current value of the corresponding element if called +#without additional arguments. Set the element to the supplied value +#(and return the new value) if called with an additional argument. +# +#Applicable to objects of type C<$ptrname>. +# +#=back +# +EOF + $pod =~ s/^\#//gm; + return $pod; +} + # Should be called before any actual call to normalize_type(). sub get_typemap { # We do not want to read ./typemap by obvios reasons. @@ -1196,10 +1649,11 @@ sub normalize_type { # Second arg: do not strip const's before \* = "(?:\\b(?:(?:__const__|const)$keep_deep_const|static|inline|__inline__)\\b\\s*)*"; if ($do_keep_deep_const) { # Keep different compiled /RExen/o separately! $type =~ s/$ignore_mods//go; - } else { + } + else { $type =~ s/$ignore_mods//go; } - $type =~ s/([^\s\w])/ \1 /g; + $type =~ s/([^\s\w])/ $1 /g; $type =~ s/\s+$//; $type =~ s/^\s+//; $type =~ s/\s+/ /g; @@ -1233,8 +1687,17 @@ sub assign_typemap_entry { return $entry; } +for (@vdecls) { + print_tievar_xsubs(\*XS, $_, $vdecl_hash{$_}); +} + if ($opt_x) { - for my $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) } + for my $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) } + if ($opt_a) { + while (my($name, $struct) = each %structs) { + print_accessors(\*XS, $name, $struct); + } + } } close XS; @@ -1278,49 +1741,114 @@ EOP warn "Writing $ext$modpname/Makefile.PL\n"; open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; -print PL <<'END'; +print PL < '$module', + 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + (\$] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => '$modfname.pm', # retrieve abstract from module + AUTHOR => '$author <$email>') : ()), END -print PL "WriteMakefile(\n"; -print PL " 'NAME' => '$module',\n"; -print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n"; -if( ! $opt_X ){ # print C stuff, unless XS is disabled +if (!$opt_X) { # print C stuff, unless XS is disabled $opt_F = '' unless defined $opt_F; - print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n"; - print PL " 'DEFINE' => '$opt_F', # e.g., '-DHAVE_SOMETHING' \n"; - print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n"; + my $I = (((glob '*.h') || (glob '*.hh')) ? '-I.' : ''); + my $Ihelp = ($I ? '-I. ' : ''); + my $Icomment = ($I ? '' : < ['$extralibs'], # e.g., '-lm' + 'DEFINE' => '$opt_F', # e.g., '-DHAVE_SOMETHING' +$Icomment 'INC' => '$I', # e.g., '${Ihelp}-I/usr/include/other' +END + + my $C = grep $_ ne "$modfname.c", (glob '*.c'), (glob '*.cc'), (glob '*.C'); + my $Cpre = ($C ? '' : '# '); + my $Ccomment = ($C ? '' : < '\$(O_FILES)', # link all the C files too +END } print PL ");\n"; close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n"; +# Create a simple README since this is a CPAN requirement +# and it doesnt hurt to have one +warn "Writing $ext$modpname/README\n"; +open(RM, ">README") || die "Can't create $ext$modpname/README:$!\n"; +my $thisyear = (gmtime)[5] + 1900; +my $rmhead = "$modpname version $TEMPLATE_VERSION"; +my $rmheadeq = "=" x length($rmhead); +print RM <<_RMEND_; +$rmhead +$rmheadeq + +The README is used to introduce the module and provide instructions on +how to install the module, any machine dependencies it may have (for +example C compilers and installed libraries) and any other information +that should be provided before the module is installed. + +A README file is required for CPAN modules since CPAN extracts the +README file from a module distribution so that people browsing the +archive can use it get an idea of the modules uses. It is usually a +good idea to provide version information here so that people can +decide whether fixes for the module are worth downloading. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + blah blah blah + +COPYRIGHT AND LICENCE + +Put the correct copyright and licence information here. + +Copyright (C) $thisyear $author blah blah blah + +_RMEND_ +close(RM) || die "Can't close $ext$modpname/README: $!\n"; + warn "Writing $ext$modpname/test.pl\n"; open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n"; print EX <<'_END_'; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' -######################### We start with some black magic to print on failure. +######################### -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) +# change 'tests => 1' to 'tests => last_test_to_print'; -BEGIN { $| = 1; print "1..1\n"; } -END {print "not ok 1\n" unless $loaded;} +use Test; +BEGIN { plan tests => 1 }; _END_ print EX <<_END_; use $module; _END_ print EX <<'_END_'; -$loaded = 1; -print "ok 1\n"; +ok(1); # If we made it this far, we're ok. -######################### End of black magic. +######################### -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): +# Insert your test code below, the Test module is use()ed here so read +# its man page ( perldoc Test ) for help writing this test script. _END_ close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";