[cairo-commit] cairo-perl ChangeLog, 1.3, 1.4 MakeHelper.pm, NONE,
1.1 MANIFEST, 1.3, 1.4 MANIFEST.SKIP, 1.3, 1.4 META.yml, 1.1,
1.2 Makefile.PL, 1.3, 1.4
Ross McFarland
commit at pdx.freedesktop.org
Sun Nov 28 10:27:13 PST 2004
Committed by: rwmcfa1
Update of /cvs/cairo/cairo-perl
In directory gabe:/tmp/cvs-serv18212
Modified Files:
ChangeLog MANIFEST MANIFEST.SKIP META.yml Makefile.PL
Added Files:
MakeHelper.pm
Log Message:
* Makefile.PL, MakeHelper.pm: initial import of MakeHelper, mess of
code moved out of Makefile.PL into it. beginning of cleaning all that
up. File::Spec now used.
* examples/png/*: initial import of port of cairo-demo/png examples,
except text.
* META.yml: unknown version
* MANIFEST, MANIFEST.SKIP: updates
Index: ChangeLog
===================================================================
RCS file: /cvs/cairo/cairo-perl/ChangeLog,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- ChangeLog 12 Nov 2004 03:26:34 -0000 1.3
+++ ChangeLog 28 Nov 2004 18:27:10 -0000 1.4
@@ -1,3 +1,16 @@
+2004/11/28 13:20 (-0500) rwmcfa1
+
+ * Makefile.PL, MakeHelper.pm: initial import of MakeHelper, mess of
+ code moved out of Makefile.PL into it. beginning of cleaning all that
+ up. File::Spec now used.
+
+ * examples/png/*: initial import of port of cairo-demo/png examples,
+ except text.
+
+ * META.yml: unknown version
+
+ * MANIFEST, MANIFEST.SKIP: updates
+
2004/11/11 22:10 (-0500) rwmcfa1
* t/CairoMatrix.t, t/CairoPattern.t, t/CairoSurface.t: initial import,
--- NEW FILE: MakeHelper.pm ---
#
# this is all hacky etc. it works so it's gonna stay for now. it is not and
# should not be installed.
#
# $Header: /cvs/cairo/cairo-perl/MakeHelper.pm,v 1.1 2004/11/28 18:27:10 rwmcfa1 Exp $
#
package MakeHelper;
use strict;
use warnings;
use IO::File;
use File::Spec;
our $autogen_dir = '.';
# copied/borrowed from Gtk2-Perl's CodeGen
sub write_boot
{
my %opts = (
ignore => '^[^:]+$', # ignore package with no colons in it
filename => File::Spec->catdir ($autogen_dir,
'cairo-perl-boot.xsh'),
'glob' => File::Spec->catfile ('xs', '*.xs'),
@_,
);
my $ignore = $opts{ignore};
my $file = IO::File->new (">$opts{filename}")
or die "Cannot write $opts{filename}: $!";
print $file "\n\n/* This file is automatically generated, any changes made here will be lost! */\n\n";
my %boot=();
my @xs_files = 'ARRAY' eq ref $opts{xs_files}
? @{ $opts{xs_files} }
: glob $opts{'glob'};
foreach my $xsfile (@xs_files) {
my $in = IO::File->new ($xsfile)
or die "can't open $xsfile: $!\n";
while (<$in>) {
next unless m/^MODULE\s*=\s*(\S+)/;
#warn "found $1 in $&\n";
my $package = $1;
next if $package =~ m/$ignore/;
$package =~ s/:/_/g;
my $sym = "boot_$package";
print $file "CAIRO_PERL_CALL_BOOT ($sym);\n"
unless $boot{$sym};
$boot{$sym}++;
}
close $in;
}
close $file;
}
sub do_typemaps
{
my %objects = %{shift ()};
my %structs = %{shift ()};
my %enums = %{shift ()};
my $cairo_perl = File::Spec->catfile ($autogen_dir,
'cairo-perl-auto.typemap');
open TYPEMAP, '>'.$cairo_perl
or die "unable to open ($cairo_perl) for output";
print TYPEMAP "#\n#\n#\n\nTYPEMAP\n\n";
sub type_id
{
my $ret = shift;
$ret =~ s/ \*//;
uc ($ret);
}
sub func_name
{
$_[0] =~ /cairo_(\w+)_t/;
$1;
}
foreach (keys %objects, keys %structs, keys %enums)
{
print TYPEMAP $_."\t".type_id ($_)."\n";
}
print TYPEMAP "\nINPUT\n\n";
foreach (keys %objects)
{
print TYPEMAP type_id ($_).'
if (sv_derived_from($arg, \"'.$objects{$_}.'\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type,tmp);
}
else
Perl_croak(aTHX_ \"$var is not of type '.$objects{$_}.'\")
';
}
foreach (keys %structs)
{
print TYPEMAP type_id ($_).'
if (sv_derived_from($arg, \"'.$structs{$_}.'\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type,tmp);
}
else
Perl_croak(aTHX_ \"$var is not of type '.$structs{$_}.'\")
';
}
foreach (keys %enums)
{
print TYPEMAP type_id ($_).'
$var = cairo_'.func_name ($_).'_from_sv ($arg);
';
}
print TYPEMAP "\nOUTPUT\n\n";
my $ref;
foreach (keys %objects)
{
/^(.*)_t \*/;
$ref = $1.'_reference';
print TYPEMAP type_id ($_)."
$ref (".'$var);
sv_setref_pv($arg, \"'.$objects{$_}.'\", (void*)$var);
';
}
foreach (keys %structs)
{
print TYPEMAP type_id ($_).'
sv_setref_pv($arg, \"'.$structs{$_}.'\", (void*)$var);
';
}
foreach (keys %enums)
{
print TYPEMAP type_id ($_).'
$arg = cairo_'.func_name ($_).'_to_sv ($var);
';
}
close TYPEMAP;
return ($cairo_perl);
}
sub do_enums
{
my %enums = %{shift ()};
my $cairo_enums = 'CairoEnums.xs';
open ENUMS, '>'.$cairo_enums
or die "unable to open ($cairo_enums) for output";
sub name
{
$_[0] =~ /cairo_(\w+)_t/;
$1;
}
print ENUMS "
/*
*
*/
#include <cairo-perl.h>
";
sub if_tree_from
{
my @enums = @_;
my $prefix = shift @enums;
my $full = shift @enums;
my $name = $full;
$name =~ s/$prefix//;
my $len = length ($name);
my $str = " if (strncmp (str, \"$name\", $len) == 0)
return $full;
";
foreach $full (@enums)
{
$name = $full;
$name =~ s/$prefix//;
$len = length ($name);
$str .= " else if (strncmp (str, \"$name\", $len) == 0)
return $full;
";
}
$str;
}
sub if_tree_to
{
my @enums = @_;
my $prefix = shift @enums;
my $full = shift @enums;
my $name = $full;
$name =~ s/$prefix//;
my $str = " if (val == $full)
return newSVpv (\"$name\", 0);
";
foreach $full (@enums)
{
$name = $full;
$name =~ s/$prefix//;
$str .= " else if (val == $full)
return newSVpv (\"$name\", 0);
";
}
$str;
}
open HDR, ">$autogen_dir/cairo-perl-enums.h";
print HDR "/*
*
*/
#ifndef _CAIRO_PERL_ENUMS_H_
#define _CAIRO_PERL_ENUMS_H_
";
foreach (keys %enums)
{
my $name = name ($_);
print HDR "
int cairo_".$name."_from_sv (SV * $name);
SV * cairo_".$name."_to_sv (int val);
";
print ENUMS 'int
cairo_'.$name.'_from_sv (SV * '.$name.')
{
char * str = SvPV_nolen ('.$name.');
'.if_tree_from (@{$enums{$_}}).'
croak ("bad value for '.$name.' (%s)\n", str);
free (str);
return 0;
}
SV *
cairo_'.$name.'_to_sv (int val)
{
'.if_tree_to (@{$enums{$_}}).'
return newSVpv ("unknown/invalid", 0);
}
';
}
print HDR "
#endif /* _CAIRO_PERL_ENUMS_H_ */\n";
close HDR;
print ENUMS "MODULE = Cairo::Enums PACKAGE = Cairo::Enums PREFIX = cairo_enums_
";
close ENUMS;
return ($cairo_enums);
}
1;
Index: MANIFEST
===================================================================
RCS file: /cvs/cairo/cairo-perl/MANIFEST,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- MANIFEST 12 Nov 2004 03:26:34 -0000 1.3
+++ MANIFEST 28 Nov 2004 18:27:10 -0000 1.4
@@ -7,8 +7,17 @@
CairoPattern.xs
CairoSurface.xs
ChangeLog
+examples/png/caps_joins.pl
+examples/png/hering.pl
+examples/png/outline.pl
+examples/png/README
+examples/png/spiral.pl
+examples/png/splines_tolerance.pl
+examples/png/stars.pl
+examples/simple.pl
LICENSE
Makefile.PL
+MakeHelper.pm
MANIFEST
MANIFEST.SKIP
META.yml
Index: MANIFEST.SKIP
===================================================================
RCS file: /cvs/cairo/cairo-perl/MANIFEST.SKIP,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- MANIFEST.SKIP 12 Nov 2004 03:26:34 -0000 1.3
+++ MANIFEST.SKIP 28 Nov 2004 18:27:10 -0000 1.4
@@ -9,5 +9,6 @@
Makefile\.old
.*\.o
pm_to_blib
+.*\.png
.*\.swp
.*\.tar\.gz
Index: META.yml
===================================================================
RCS file: /cvs/cairo/cairo-perl/META.yml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- META.yml 5 Nov 2004 01:34:04 -0000 1.1
+++ META.yml 28 Nov 2004 18:27:10 -0000 1.2
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Cairo
-version: 0.02
+version: unknown
version_from: Cairo.pm
installdirs: site
requires:
Index: Makefile.PL
===================================================================
RCS file: /cvs/cairo/cairo-perl/Makefile.PL,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Makefile.PL 11 Nov 2004 02:20:32 -0000 1.3
+++ Makefile.PL 28 Nov 2004 18:27:10 -0000 1.4
@@ -6,32 +6,30 @@
# $Header$
#
# TODO:
-# - file spec
-# - pull a lot of this out into a helper pm or something
# - man this is horribly ulgy, stream-of-cons. even.
#
use strict;
use warnings;
-use Data::Dumper;
use ExtUtils::PkgConfig;
use ExtUtils::MakeMaker;
-use IO::File;
-our $autogen_dir = 'build';
+use MakeHelper;
+
+my $autogen_dir = 'build';
mkdir $autogen_dir unless (-d $autogen_dir);
+$MakeHelper::autogen_dir = $autogen_dir;
my %cairo_cfg = ExtUtils::PkgConfig->find ('cairo');
-#print Dumper (\%cairo_cfg);
-our %objects = (
+my %objects = (
'cairo_t *' => 'Cairo',
'cairo_surface_t *' => 'Cairo::Surface',
'cairo_pattern_t *' => 'Cairo::Pattern',
'cairo_font_t *' => 'Cairo::Font',
);
-our %structs = (
+my %structs = (
'cairo_matrix_t *' => 'Cairo::Matrix',
'cairo_glyph_t *' => 'Cairo::Glyph',
'cairo_font_extents_t *' => 'Cairo::Font::Extents',
@@ -39,7 +37,7 @@
'glitz_surface_t *' => 'Glitz::Surface',
);
-our %enums = (
+my %enums = (
cairo_format_t => [qw/
CAIRO_FORMAT_
CAIRO_FORMAT_ARGB32
@@ -121,22 +119,28 @@
);
my @xs_files = <*.xs>;
-my %xs = map { /^(.*)\.xs$/; $_ => "$1.c"; } @xs_files, do_enums ();
+my %xs = map { /^(.*)\.xs$/; $_ => "$1.c"; } @xs_files,
+ MakeHelper::do_enums (\%enums);
-write_boot (
+MakeHelper::write_boot (
xs_files => \@xs_files,
ignore => '(^Cairo$|Enums)',
);
-my @typemaps = do_typemaps ();
+my @typemaps = MakeHelper::do_typemaps (\%objects, \%structs, \%enums);
push @typemaps, 'cairo-perl.typemap';
+my %pm = (
+ 'Cairo.pm' => '$(INST_LIBDIR)/Cairo.pm',
+);
+
WriteMakefile (
NAME => 'Cairo',
VERSION_FROM => 'Cairo.pm',
- INC => '-I. -I./'.$autogen_dir.' '.$cairo_cfg{cflags},
+ INC => '-I. -I'.$autogen_dir.' '.$cairo_cfg{cflags},
LIBS => $cairo_cfg{libs},
XS => \%xs,
+ PM => \%pm,
OBJECT => q/$(O_FILES)/,
XSPROTOARG => '-noprototypes',
TYPEMAPS => \@typemaps,
@@ -147,279 +151,9 @@
sub postamble
{
+ my $autogen_dir = $MakeHelper::autogen_dir;
+
"realclean ::
-\$(RM_RF) $autogen_dir CairoEnums.xs";
}
-package main;
-
-# copied/borrowed from Gtk2-Perl's CodeGen
-sub write_boot
-{
- my %opts = (
- ignore => '^[^:]+$', # ignore package with no colons in it
- filename => $autogen_dir.'/cairo-perl-boot.xsh',
- 'glob' => 'xs/*.xs',
- @_,
- );
- my $ignore = $opts{ignore};
-
- my $file = IO::File->new (">$opts{filename}")
- or die "Cannot write $opts{filename}: $!";
-
- print $file "\n\n/* This file is automatically generated, any changes made here will be lost! */\n\n";
-
- my %boot=();
-
- my @xs_files = 'ARRAY' eq ref $opts{xs_files}
- ? @{ $opts{xs_files} }
- : glob $opts{'glob'};
-
- foreach my $xsfile (@xs_files) {
- my $in = IO::File->new ($xsfile)
- or die "can't open $xsfile: $!\n";
-
- while (<$in>) {
- next unless m/^MODULE\s*=\s*(\S+)/;
- #warn "found $1 in $&\n";
-
- my $package = $1;
-
- next if $package =~ m/$ignore/;
-
- $package =~ s/:/_/g;
- my $sym = "boot_$package";
- print $file "CAIRO_PERL_CALL_BOOT ($sym);\n"
- unless $boot{$sym};
- $boot{$sym}++;
- }
-
- close $in;
- }
-
- close $file;
-}
-
-sub do_typemaps
-{
- my $cairo_perl = $autogen_dir.'/cairo-perl-auto.typemap';
- open TYPEMAP, '>'.$cairo_perl
- or die "unable to open ($cairo_perl) for output";
-
- print TYPEMAP "#\n#\n#\n\nTYPEMAP\n\n";
-
- sub type_id
- {
- my $ret = shift;
- $ret =~ s/ \*//;
- uc ($ret);
- }
-
- sub func_name
- {
- $_[0] =~ /cairo_(\w+)_t/;
- $1;
- }
-
- foreach (keys %objects, keys %structs, keys %enums)
- {
- print TYPEMAP $_."\t".type_id ($_)."\n";
- }
-
- print TYPEMAP "\nINPUT\n\n";
-
- foreach (keys %objects)
- {
- print TYPEMAP type_id ($_).'
- if (sv_derived_from($arg, \"'.$objects{$_}.'\")) {
- IV tmp = SvIV((SV*)SvRV($arg));
- $var = INT2PTR($type,tmp);
- }
- else
- Perl_croak(aTHX_ \"$var is not of type '.$objects{$_}.'\")
-
-';
- }
-
- foreach (keys %structs)
- {
- print TYPEMAP type_id ($_).'
- if (sv_derived_from($arg, \"'.$structs{$_}.'\")) {
- IV tmp = SvIV((SV*)SvRV($arg));
- $var = INT2PTR($type,tmp);
- }
- else
- Perl_croak(aTHX_ \"$var is not of type '.$structs{$_}.'\")
-
-';
- }
-
- foreach (keys %enums)
- {
- print TYPEMAP type_id ($_).'
- $var = cairo_'.func_name ($_).'_from_sv ($arg);
-
-';
- }
-
- print TYPEMAP "\nOUTPUT\n\n";
-
- my $ref;
- foreach (keys %objects)
- {
- /^(.*)_t \*/;
- $ref = $1.'_reference';
- print TYPEMAP type_id ($_)."
- $ref (".'$var);
- sv_setref_pv($arg, \"'.$objects{$_}.'\", (void*)$var);
-
-';
- }
-
- foreach (keys %structs)
- {
- print TYPEMAP type_id ($_).'
- sv_setref_pv($arg, \"'.$structs{$_}.'\", (void*)$var);
-
-';
- }
-
- foreach (keys %enums)
- {
- print TYPEMAP type_id ($_).'
- $arg = cairo_'.func_name ($_).'_to_sv ($var);
-
-';
- }
-
- close TYPEMAP;
-
- return ($cairo_perl);
-}
-
-sub do_enums
-{
- my $cairo_enums = 'CairoEnums.xs';
- open ENUMS, '>'.$cairo_enums
- or die "unable to open ($cairo_enums) for output";
-
- sub name
- {
- $_[0] =~ /cairo_(\w+)_t/;
- $1;
- }
-
- print ENUMS "
-/*
- *
- */
-
-#include <cairo-perl.h>
-
-";
-
- sub if_tree_from
- {
- my @enums = @_;
-
- my $prefix = shift @enums;
-
- my $full = shift @enums;
- my $name = $full;
- $name =~ s/$prefix//;
- my $len = length ($name);
-
- my $str = " if (strncmp (str, \"$name\", $len) == 0)
- return $full;
-";
-
- foreach $full (@enums)
- {
- $name = $full;
- $name =~ s/$prefix//;
- $len = length ($name);
-
- $str .= " else if (strncmp (str, \"$name\", $len) == 0)
- return $full;
-";
- }
-
- $str;
- }
-
- sub if_tree_to
- {
- my @enums = @_;
-
- my $prefix = shift @enums;
- my $full = shift @enums;
- my $name = $full;
- $name =~ s/$prefix//;
-
- my $str = " if (val == $full)
- return newSVpv (\"$name\", 0);
-";
-
- foreach $full (@enums)
- {
- $name = $full;
- $name =~ s/$prefix//;
- $str .= " else if (val == $full)
- return newSVpv (\"$name\", 0);
-";
- }
-
- $str;
- }
-
- open HDR, ">$autogen_dir/cairo-perl-enums.h";
- print HDR "/*
- *
- */
-
-#ifndef _CAIRO_PERL_ENUMS_H_
-#define _CAIRO_PERL_ENUMS_H_
-";
-
- foreach (keys %enums)
- {
- my $name = name ($_);
-
- print HDR "
-int cairo_".$name."_from_sv (SV * $name);
-SV * cairo_".$name."_to_sv (int val);
-";
-
- print ENUMS 'int
-cairo_'.$name.'_from_sv (SV * '.$name.')
-{
- char * str = SvPV_nolen ('.$name.');
-
-'.if_tree_from (@{$enums{$_}}).'
- croak ("bad value for '.$name.' (%s)\n", str);
-
- free (str);
- return 0;
-}
-
-SV *
-cairo_'.$name.'_to_sv (int val)
-{
-'.if_tree_to (@{$enums{$_}}).'
- return newSVpv ("unknown/invalid", 0);
-}
-
-';
- }
-
- print HDR "
-#endif /* _CAIRO_PERL_ENUMS_H_ */\n";
- close HDR;
-
- print ENUMS "MODULE = Cairo::Enums PACKAGE = Cairo::Enums PREFIX = cairo_enums_
-
-";
-
- close ENUMS;
- return ($cairo_enums);
-}
More information about the cairo-commit
mailing list