-#!../../../perl -w
+#!./perl
BEGIN {
- # fiddle with @INC iff I am a part of perl dist
- if ($^X =~ m/\bminiperl$/o){
- warn "Fixing \@INC for perl core.\n";
- unshift @INC, qw(../../lib ../../../lib ../../../../lib);
- $ENV{PATH} .= ';../..;../../..;../../../..' if $^O eq 'MSWin32';
- }
+ # @INC poking no longer needed w/ new MakeMaker and Makefile.PL's
+ # with $ENV{PERL_CORE} set
+ # In case we need it in future...
+ require Config; import Config;
}
use strict;
use Getopt::Std;
my @orig_ARGV = @ARGV;
-our $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
-
+our $VERSION = do { my @r = (q$Revision: 1.20 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
# These may get re-ordered.
# RAW is a do_now as inserted by &enter
# AGG is an aggreagated do_now, as built up by &process
+
use constant {
RAW_NEXT => 0,
RAW_IN_LEN => 1,
AGG_OUT_LEN => 5,
AGG_FALLBACK => 6,
};
+
# (See the algorithm in encengine.c - we're building structures for it)
# There are two sorts of structures.
if ($cname =~ /\.(c|xs)$/)
{
$doC = 1;
- $dname =~ s/(\.[^\.]*)?$/_def.h/;
+ $dname =~ s/(\.[^\.]*)?$/.exh/;
chmod(0666,$dname) if -f $cname && !-w $dname;
open(D,">$dname") || die "Cannot open $dname:$!";
$hname =~ s/(\.[^\.]*)?$/.h/;
s/#.*$//;
last if /^\s*END\s+CHARMAP\s*$/i;
next if /^\s*$/;
- my ($u,@byte);
- my $fb = '';
- $u = $1 if (/^<U([0-9a-f]+)>\s+/igc);
- push(@byte,$1) while /\G\\x([0-9a-f]+)/igc;
- $fb = $1 if /\G\s*(\|[0-3])/gc;
- # warn "$_: $u @byte | $fb\n";
- die "Bad line:$_" unless /\G\s*(#.*)?$/gc;
- if (defined($u))
+ my (@uni, @byte) = ();
+ my ($uni, $byte, $fb) = m/^(\S+)\s+(\S+)\s+(\S+)\s+/o
+ or die "Bad line: $_";
+ while ($uni =~ m/\G<([U0-9a-fA-F\+]+)>/g){
+ push @uni, map { substr($_, 1) } split(/\+/, $1);
+ }
+ while ($byte =~ m/\G\\x([0-9a-fA-F]+)/g){
+ push @byte, $1;
+ }
+ if (@uni)
{
- my $uch = encode_U(hex($u));
+ my $uch = join('', map { encode_U(hex($_)) } @uni );
my $ech = join('',map(chr(hex($_)),@byte));
my $el = length($ech);
$max_el = $el if (!defined($max_el) || $el > $max_el);
print $fh "END CHARMAP\n";
}
+use vars qw(
+ $_Enc2xs
+ $_Version
+ $_Inc
+ $_Name
+ $_TableFiles
+ $_Now
+);
+
sub make_makefile_pl
{
eval { require Encode; };
$@ and die "You need to install Encode to use enc2xs -M\nerror: $@\n";
+ # our used for variable expanstion
+ $_Enc2xs = $0;
+ $_Version = $VERSION;
+ $_Inc = $INC{"Encode.pm"}; $_Inc =~ s/\.pm$//o;
+ $_Name = shift;
+ $_TableFiles = join(",", map {qq('$_')} @_);
+ $_Now = scalar localtime();
+ warn "Generating Makefile.PL\n";
+ _print_expand("$_Inc/Makefile_PL.e2x", "Makefile.PL");
+ warn "Generating $_Name.pm\n";
+ _print_expand("$_Inc/_PM.e2x", "$_Name.pm");
+ warn "Generating t/$_Name.t\n";
+ _print_expand("$_Inc/_T.e2x", "t/$_Name.t");
+ warn "Generating README\n";
+ _print_expand("$_Inc/README.e2x", "README");
+ warn "Generating t/$_Name.t\n";
+ _print_expand("$_Inc/Changes.e2x", "Changes");
+ exit;
+}
+
+sub _print_expand{
eval { require File::Basename; };
$@ and die "File::Basename needed. Are you on miniperl?;\nerror: $@\n";
File::Basename->import();
- my $inc = dirname($INC{"Encode/Internal.pm"});
- my $name = shift;
- my $table_files = join(",", map {qq('$_')} @_);
- my $now = scalar localtime();
- open my $fh, ">Makefile.PL" or die "$!";
- print $fh <<"END_OF_HEADER";
-#
-# This file is auto-generated by:
-# $0
-# $now
-#
-use 5.7.2;
-use strict;
-use ExtUtils::MakeMaker;
-
-# Please edit the following to the taste!
-my \$name = '$name';
-my \%tables = (
- encode_t => [ $table_files ],
- );
-
-# And leave the rest!
-my \$enc2xs = '$0';
-WriteMakefile(
- INC => "-I$inc",
-END_OF_HEADER
-
- print $fh <<'END_OF_MAKEFILE_PL';
- NAME => 'Encode::'.$name,
- VERSION_FROM => "$name.pm",
- OBJECT => '$(O_FILES)',
- 'dist' => {
- COMPRESS => 'gzip -9f',
- SUFFIX => 'gz',
- DIST_DEFAULT => 'all tardist',
- },
- MAN3PODS => {},
- # OS 390 winges about line numbers > 64K ???
- XSOPT => '-nolinenumbers',
- );
-
-package MY;
-
-sub post_initialize
-{
- my ($self) = @_;
- my %o;
- my $x = $self->{'OBJ_EXT'};
- # Add the table O_FILES
- foreach my $e (keys %tables)
- {
- $o{$e.$x} = 1;
+ my ($src, $dst) = @_;
+ open my $in, $src or die "$src : $!";
+ if ((my $d = dirname($dst)) ne '.'){
+ -d $d or mkdir $d, 0755 or die "mkdir $d : $!";
+ }
+ open my $out, ">$dst" or die "$!";
+ my $asis = 0;
+ while (<$in>){
+ if (/^#### END_OF_HEADER/){
+ $asis = 1; next;
+ }
+ s/(\$_[A-Z][A-Za-z0-9]+)_/$1/gee unless $asis;
+ print $out $_;
}
- $o{"$name$x"} = 1;
- $self->{'O_FILES'} = [sort keys %o];
- my @files = ("$name.xs");
- $self->{'C'} = ["$name.c"];
- # $self->{'H'} = [$self->catfile($self->updir,'encode.h')];
- my %xs;
- foreach my $table (keys %tables) {
- push (@{$self->{'C'}},"$table.c");
- # Do NOT add $table.h etc. to H_FILES unless we own up as to how they
- # get built.
- foreach my $ext (qw($(OBJ_EXT) .c .h _def.h .fnm)) {
- push (@files,$table.$ext);
- }
- }
- $self->{'XS'} = { "$name.xs" => "$name.c" };
- $self->{'clean'}{'FILES'} .= join(' ',@files);
- open(XS,">$name.xs") || die "Cannot open $name.xs:$!";
- print XS <<'END';
-#include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
-#define U8 U8
-#include "encode.h"
-END
- foreach my $table (keys %tables) {
- print XS qq[#include "${table}.h"\n];
- }
- print XS <<"END";
-
-static void
-Encode_XSEncoding(pTHX_ encode_t *enc)
-{
- dSP;
- HV *stash = gv_stashpv("Encode::XS", TRUE);
- SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
- int i = 0;
- PUSHMARK(sp);
- XPUSHs(sv);
- while (enc->name[i])
- {
- const char *name = enc->name[i++];
- XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
- }
- PUTBACK;
- call_pv("Encode::define_encoding",G_DISCARD);
- SvREFCNT_dec(sv);
-}
-
-MODULE = Encode::$name PACKAGE = Encode::$name
-PROTOTYPES: DISABLE
-BOOT:
-{
-END
- foreach my $table (keys %tables) {
- print XS qq[#include "${table}_def.h"\n];
- }
- print XS "}\n";
- close(XS);
- return "# Built $name.xs\n\n";
}
-
-sub postamble
-{
- my $self = shift;
- my $dir = "."; # $self->catdir('Encode');
- my $str = "# $name\$(OBJ_EXT) depends on .h and _def.h files not .c files - but all written by enc2xs\n";
- $str .= "$name.c : $name.xs ";
- foreach my $table (keys %tables)
- {
- $str .= " $table.c";
- }
- $str .= "\n\n";
- $str .= "$name\$(OBJ_EXT) : $name.c\n\n";
-
- foreach my $table (keys %tables)
- {
- my $numlines = 1;
- my $lengthsofar = length($str);
- my $continuator = '';
- $str .= "$table.c : Makefile.PL";
- foreach my $file (@{$tables{$table}})
- {
- $str .= $continuator.' '.$self->catfile($dir,$file);
- if ( length($str)-$lengthsofar > 128*$numlines )
- {
- $continuator .= " \\\n\t";
- $numlines++;
- } else {
- $continuator = '';
- }
- }
- $str .= $^O eq 'VMS' # In VMS quote to preserve case
- ? qq{\n\t\$(PERL) $enc2xs -"Q" -"O" -o \$\@ -f $table.fnm\n\n}
- : qq{\n\t\$(PERL) $enc2xs -Q -O -o \$\@ -f $table.fnm\n\n};
- open (FILELIST, ">$table.fnm")
- || die "Could not open $table.fnm: $!";
- foreach my $file (@{$tables{$table}})
- {
- print FILELIST $self->catfile($dir,$file) . "\n";
- }
- close(FILELIST);
- }
- return $str;
-}
-END_OF_MAKEFILE_PL
- close $fh;
- (my $pm =<<"END_OF_PM") =~ s/^# //gm;
-# package Encode::$name;
-# our \$VERSION = "0.01";
-#
-# use Encode;
-# use XSLoader;
-# XSLoader::load('Encode::$name', \$VERSION);
-#
-# 1;
-# __END__
-#
-# =head1 NAME
-#
-# Encode::$name - New Encoding
-#
-# =head1 SYNOPSIS
-#
-# You got to fill this in!
-#
-# =head1 SEE ALSO
-#
-# L<Encode>
-#
-# =cut
-END_OF_PM
- open $fh, ">$name.pm" or die "$name.pm:$!";
- print $fh $pm;
- close $fh;
- -d 't' or mkdir 't', 0755 or die "mkdir t:$!";
- open $fh, ">t/$name.t" or die "t/$name.t:$!";
-print $fh <<"END_OF_TEST";
-use strict;
-# Adjust the number here!
-use Test::More tests => 2;
-
-use_ok('Encode');
-use_ok('Encode::$name');
-# Add more test here!
-END_OF_TEST
- close $fh;
- exit;
-}
-
__END__
=head1 NAME
Issue a command as follows;
$ enc2xs -M My my.ucm
+ generating Makefile.PL
+ generating My.pm
+ generating README
+ generating Changes
Now take a look at your current directory. It should look like this.