1use 5.7.2; 2use strict; 3use ExtUtils::MakeMaker; 4 5my $name = 'EBCDIC'; 6my %tables = ( 7 ebcdic_t => 8 ['posix-bc.ucm', 9 qw(cp037.ucm cp1026.ucm cp1047.ucm cp500.ucm cp875.ucm), 10 ], 11 ); 12 13WriteMakefile( 14 INC => "-I../Encode", 15 NAME => 'Encode::'.$name, 16 VERSION_FROM => "$name.pm", 17 OBJECT => '$(O_FILES)', 18 'dist' => { 19 COMPRESS => 'gzip -9f', 20 SUFFIX => 'gz', 21 DIST_DEFAULT => 'all tardist', 22 }, 23 MAN3PODS => {}, 24 # OS 390 winges about line numbers > 64K ??? 25 XSOPT => '-nolinenumbers', 26 ); 27 28package MY; 29 30sub post_initialize 31{ 32 my ($self) = @_; 33 my %o; 34 my $x = $self->{'OBJ_EXT'}; 35 # Add the table O_FILES 36 foreach my $e (keys %tables) 37 { 38 $o{$e.$x} = 1; 39 } 40 $o{"$name$x"} = 1; 41 $self->{'O_FILES'} = [sort keys %o]; 42 my @files = ("$name.xs"); 43 $self->{'C'} = ["$name.c"]; 44 $self->{SOURCE} .= " $name.c" 45 if $^O eq 'MacOS' && $self->{SOURCE} !~ /\b$name\.c\b/; 46 $self->{'H'} = [$self->catfile($self->updir,'Encode', 'encode.h')]; 47 my %xs; 48 foreach my $table (sort keys %tables) { 49 push (@{$self->{'C'}},"$table.c"); 50 # Do NOT add $table.h etc. to H_FILES unless we own up as to how they 51 # get built. 52 foreach my $ext (qw($(OBJ_EXT) .c .h .exh .fnm)) { 53 push (@files,$table.$ext); 54 } 55 $self->{SOURCE} .= " $table.c" 56 if $^O eq 'MacOS' && $self->{SOURCE} !~ /\b$table\.c\b/; 57 } 58 $self->{'XS'} = { "$name.xs" => "$name.c" }; 59 $self->{'clean'}{'FILES'} .= join(' ',@files); 60 open(XS,">$name.xs") || die "Cannot open $name.xs:$!"; 61 print XS <<'END'; 62#define PERL_NO_GET_CONTEXT 63#include <EXTERN.h> 64#include <perl.h> 65#include <XSUB.h> 66#include "encode.h" 67END 68 foreach my $table (sort keys %tables) { 69 print XS qq[#include "${table}.h"\n]; 70 } 71 print XS <<"END"; 72 73static void 74Encode_XSEncoding(pTHX_ encode_t *enc) 75{ 76 dSP; 77 HV *stash = gv_stashpv("Encode::XS", TRUE); 78 SV *iv = newSViv(PTR2IV(enc)); 79 SV *sv = sv_bless(newRV_noinc(iv),stash); 80 int i = 0; 81 /* with the SvLEN() == 0 hack, PVX won't be freed. We cast away name's 82 constness, in the hope that perl won't mess with it. */ 83 assert(SvTYPE(iv) >= SVt_PV); assert(SvLEN(iv) == 0); 84 SvFLAGS(iv) |= SVp_POK; 85 SvPVX(iv) = (char*) enc->name[0]; 86 PUSHMARK(sp); 87 XPUSHs(sv); 88 while (enc->name[i]) 89 { 90 const char *name = enc->name[i++]; 91 XPUSHs(sv_2mortal(newSVpvn(name,strlen(name)))); 92 } 93 PUTBACK; 94 call_pv("Encode::define_encoding",G_DISCARD); 95 SvREFCNT_dec(sv); 96} 97 98MODULE = Encode::$name PACKAGE = Encode::$name 99PROTOTYPES: DISABLE 100BOOT: 101{ 102END 103 foreach my $table (sort keys %tables) { 104 print XS qq[#include "${table}.exh"\n]; 105 } 106 print XS "}\n"; 107 close(XS); 108 return "# Built $name.xs\n\n"; 109} 110 111sub postamble 112{ 113 my $self = shift; 114 my $dir = $self->catdir($self->updir,'ucm'); 115 my $str = "# $name\$(OBJ_EXT) depends on .h and .exh files not .c files - but all written by enc2xs\n"; 116 $str .= "$name.c : $name.xs "; 117 foreach my $table (sort keys %tables) 118 { 119 $str .= " $table.c"; 120 } 121 $str .= "\n\n"; 122 $str .= "$name\$(OBJ_EXT) : $name.c\n\n"; 123 124 my $enc2xs = $self->catfile($self->updir,'bin', 'enc2xs'); 125 foreach my $table (sort keys %tables) 126 { 127 my $numlines = 1; 128 my $lengthsofar = length($str); 129 my $continuator = ''; 130 $str .= "$table.c : $enc2xs Makefile.PL"; 131 foreach my $file (@{$tables{$table}}) 132 { 133 $str .= $continuator.' '.$self->catfile($dir,$file); 134 if ( length($str)-$lengthsofar > 128*$numlines ) 135 { 136 $continuator .= " \\\n\t"; 137 $numlines++; 138 } else { 139 $continuator = ''; 140 } 141 } 142 my $plib = $self->{PERL_CORE} ? '"-I$(PERL_LIB)"' : ''; 143 $plib .= " -MCross=$::Cross::platform" if defined $::Cross::platform; 144 my $ucopts = '-"Q" -"O"'; 145 $str .= 146 qq{\n\t\$(PERL) $plib $enc2xs $ucopts -o \$\@ -f $table.fnm\n\n}; 147 open (FILELIST, ">$table.fnm") 148 || die "Could not open $table.fnm: $!"; 149 foreach my $file (@{$tables{$table}}) 150 { 151 print FILELIST $self->catfile($dir,$file) . "\n"; 152 } 153 close(FILELIST); 154 } 155 return $str; 156} 157 158