You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2009/09/07 00:18:17 UTC
svn commit: r811923 - in
/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding: ./ Perl.pm Perl/
Perl/Class.pm Perl/Constructor.pm Perl/Method.pm Perl/Subroutine.pm
Perl/TypeMap.pm
Author: marvin
Date: Sun Sep 6 22:18:16 2009
New Revision: 811923
URL: http://svn.apache.org/viewvc?rev=811923&view=rev
Log:
Commit most of LUCY-27, adding the Perl binding modules to Boilerplater.
Added:
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm (with props)
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Class.pm (with props)
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Constructor.pm (with props)
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Method.pm (with props)
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Subroutine.pm (with props)
lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/TypeMap.pm (with props)
Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm?rev=811923&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm Sun Sep 6 22:18:16 2009
@@ -0,0 +1,465 @@
+use strict;
+use warnings;
+
+package Boilerplater::Binding::Perl;
+
+use Boilerplater::Hierarchy;
+use Carp;
+use File::Spec::Functions qw( catfile );
+use Fcntl;
+
+use Boilerplater::Parcel;
+use Boilerplater::Class;
+use Boilerplater::Function;
+use Boilerplater::Method;
+use Boilerplater::Variable;
+use Boilerplater::Util qw( verify_args a_isa_b write_if_changed );
+use Boilerplater::Binding::Perl::Class;
+use Boilerplater::Binding::Perl::Method;
+use Boilerplater::Binding::Perl::Constructor;
+
+our %new_PARAMS = (
+ parcel => undef,
+ hierarchy => undef,
+ lib_dir => undef,
+ boot_class => undef,
+ header => undef,
+ footer => undef,
+);
+
+sub new {
+ my $either = shift;
+ verify_args( \%new_PARAMS, @_ ) or confess $@;
+ my $self = bless { %new_PARAMS, @_, }, ref($either) || $either;
+ if ( !a_isa_b( $self->{parcel}, 'Boilerplater::Parcel' ) ) {
+ $self->{parcel}
+ = Boilerplater::Parcel->singleton( name => $self->{parcel} );
+ }
+ my $parcel = $self->{parcel};
+ for ( keys %new_PARAMS ) {
+ confess("$_ is mandatory") unless defined $self->{$_};
+ }
+
+ # Derive filenames.
+ my $lib = $self->{lib_dir};
+ my $dest_dir = $self->{hierarchy}->get_dest;
+ my @file_components = split( '::', $self->{boot_class} );
+ my @xs_file_components = @file_components;
+ $xs_file_components[-1] .= '.xs';
+ $self->{xs_path} = catfile( $lib, @xs_file_components );
+
+ $self->{pm_path} = catfile( $lib, @file_components, 'AutoBinding.pm' );
+ $self->{boot_h_file} = $parcel->get_prefix . "boot.h";
+ $self->{boot_c_file} = $parcel->get_prefix . "boot.c";
+ $self->{boot_h_path} = catfile( $dest_dir, $self->{boot_h_file} );
+ $self->{boot_c_path} = catfile( $dest_dir, $self->{boot_c_file} );
+
+ # Derive the name of the bootstrap function.
+ $self->{boot_func}
+ = $parcel->get_prefix . $self->{boot_class} . '_bootstrap';
+ $self->{boot_func} =~ s/\W/_/g;
+
+ return $self;
+}
+
+sub write_bindings {
+ my $self = shift;
+ my @ordered = $self->{hierarchy}->ordered_classes;
+ my $registry = Boilerplater::Binding::Perl::Class->registry;
+ my $hand_rolled_xs = "";
+ my $generated_xs = "";
+ my $xs = "";
+ my @xsubs;
+
+ # Build up a roster of all requested bindings.
+ my %has_constructors;
+ my %has_methods;
+ my %has_xs_code;
+ while ( my ( $class_name, $class_binding ) = each %$registry ) {
+ $has_constructors{$class_name} = 1
+ if $class_binding->get_bind_constructors;
+ $has_methods{$class_name} = 1
+ if $class_binding->get_bind_methods;
+ $has_xs_code{$class_name} = 1
+ if $class_binding->get_xs_code;
+ }
+
+ # Pound-includes for generated headers.
+ for my $class (@ordered) {
+ my $include_h = $class->include_h;
+ $generated_xs .= qq|#include "$include_h"\n|;
+ }
+ $generated_xs .= "\n";
+
+ # Constructors.
+ for my $class (@ordered) {
+ my $class_name = $class->get_class_name;
+ next unless delete $has_constructors{$class_name};
+ my $class_binding = $registry->{$class_name};
+ my @bound = $class_binding->constructor_bindings;
+ $generated_xs .= $_->xsub_def . "\n" for @bound;
+ push @xsubs, @bound;
+ }
+
+ # Methods.
+ for my $class (@ordered) {
+ my $class_name = $class->get_class_name;
+ next unless delete $has_methods{$class_name};
+ my $class_binding = $registry->{$class_name};
+ my @bound = $class_binding->method_bindings;
+ $generated_xs .= $_->xsub_def . "\n" for @bound;
+ push @xsubs, @bound;
+ }
+
+ # Hand-rolled XS.
+ for my $class_name ( keys %has_xs_code ) {
+ my $class_binding = $registry->{$class_name};
+ $hand_rolled_xs .= $class_binding->get_xs_code . "\n";
+ }
+ %has_xs_code = ();
+
+ # Verify that all binding specs were processed.
+ my @leftover_ctor = keys %has_constructors;
+ if (@leftover_ctor) {
+ confess( "Constructor bindings spec'd for non-existant classes: "
+ . "'@leftover_ctor'" );
+ }
+ my @leftover_bound = keys %has_methods;
+ if (@leftover_bound) {
+ confess( "Method bindings spec'd for non-existant classes: "
+ . "'@leftover_bound'" );
+ }
+ my @leftover_xs = keys %has_xs_code;
+ if (@leftover_xs) {
+ confess( "Hand-rolled XS spec'd for non-existant classes: "
+ . "'@leftover_xs'" );
+ }
+
+ # Build up code for booting XSUBs at module load time.
+ my @xs_init_lines;
+ for my $xsub (@xsubs) {
+ my $c_name = $xsub->c_name;
+ my $perl_name = $xsub->perl_name;
+ push @xs_init_lines, qq|newXS("$perl_name", $c_name, file);|;
+ }
+ my $xs_init = join( "\n ", @xs_init_lines );
+
+ # Params hashes for arg checking of XSUBs that take labeled params.
+ my @params_hash_defs = grep {defined} map { $_->params_hash_def } @xsubs;
+ my $params_hash_defs = join( "\n", @params_hash_defs );
+
+ # Write out if there have been any changes.
+ my $xs_file_contents = $self->_xs_file_contents( $generated_xs, $xs_init,
+ $hand_rolled_xs );
+ my $pm_file_contents = $self->_pm_file_contents($params_hash_defs);
+ write_if_changed( $self->{xs_path}, $xs_file_contents );
+ write_if_changed( $self->{pm_path}, $pm_file_contents );
+}
+
+sub _xs_file_contents {
+ my ( $self, $generated_xs, $xs_init, $hand_rolled_xs ) = @_;
+ return <<END_STUFF;
+#define C_LUCY_ZOMBIECHARBUF
+#include "xs/XSBind.h"
+#include "boil.h"
+#include "$self->{boot_h_file}"
+
+#include "Lucy/Obj/Host.h"
+#include "Lucy/Util/MemManager.h"
+#include "Lucy/Util/StringHelper.h"
+
+#include "Charmonizer/Test.h"
+#include "Charmonizer/Test/AllTests.h"
+
+$generated_xs
+
+MODULE = Lucy PACKAGE = Lucy::Autobinding
+
+void
+init_autobindings()
+PPCODE:
+{
+ char* file = __FILE__;
+ CHY_UNUSED_VAR(cv);
+ CHY_UNUSED_VAR(items);
+ $xs_init
+}
+
+$hand_rolled_xs
+
+END_STUFF
+}
+
+sub _pm_file_contents {
+ my ( $self, $params_hash_defs ) = @_;
+ return <<END_STUFF;
+# DO NOT EDIT!!!! This is an auto-generated file.
+
+use strict;
+use warnings;
+
+package Lucy::Autobinding;
+
+init_autobindings();
+
+$params_hash_defs
+
+1;
+
+END_STUFF
+}
+
+sub prepare_pod {
+ my $self = shift;
+ my $lib_dir = $self->{lib_dir};
+ my @ordered = $self->{hierarchy}->ordered_classes;
+ my @files_written;
+ my %has_pod;
+ my %modified;
+
+ my $registry = Boilerplater::Binding::Perl::Class->registry;
+ $has_pod{ $_->get_class_name } = 1
+ for grep { $_->get_make_pod } values %$registry;
+
+ for my $class (@ordered) {
+ my $class_name = $class->get_class_name;
+ my $class_binding = $registry->{$class_name} or next;
+ next unless delete $has_pod{$class_name};
+ my $pod = $class_binding->create_pod;
+ confess("Failed to generate POD for $class_name") unless $pod;
+
+ # Compare against existing file; rewrite if changed.
+ my $pod_file_path
+ = catfile( $lib_dir, split( '::', $class_name ) ) . ".pod";
+
+ $class->file_path( $lib_dir, ".pod" );
+ my $existing = "";
+ if ( -e $pod_file_path ) {
+ open( my $pod_fh, "<", $pod_file_path )
+ or confess("Can't open '$pod_file_path': $!");
+ $existing = do { local $/; <$pod_fh> };
+ }
+ if ( $pod ne $existing ) {
+ $modified{$pod_file_path} = $pod;
+ }
+ }
+ my @leftover = keys %has_pod;
+ confess("Couldn't match pod to class for '@leftover'") if @leftover;
+
+ return \%modified;
+}
+
+sub write_boot {
+ my $self = shift;
+ $self->_write_boot_h;
+ $self->_write_boot_c;
+}
+
+sub _write_boot_h {
+ my $self = shift;
+ my $hierarchy = $self->{hierarchy};
+ my $filepath = catfile( $hierarchy->get_dest, $self->{boot_h_file} );
+ my $guard = uc("$self->{boot_class}_BOOT");
+ $guard =~ s/\W+/_/g;
+
+ unlink $filepath;
+ sysopen( my $fh, $filepath, O_CREAT | O_EXCL | O_WRONLY )
+ or confess("Can't open '$filepath': $!");
+ print $fh <<END_STUFF;
+$self->{header}
+
+#ifndef $guard
+#define $guard 1
+
+void
+$self->{boot_func}();
+
+#endif /* $guard */
+
+$self->{footer}
+END_STUFF
+}
+
+sub _write_boot_c {
+ my $self = shift;
+ my $hierarchy = $self->{hierarchy};
+ my @ordered = $hierarchy->ordered_classes;
+ my $num_classes = scalar @ordered;
+ my $pound_includes = "";
+ my $registrations = "";
+ my $isa_pushes = "";
+
+ for my $class (@ordered) {
+ my $include_h = $class->include_h;
+ $pound_includes .= qq|#include "$include_h"\n|;
+ next if $class->inert;
+ my $prefix = $class->get_prefix;
+ my $PREFIX = $class->get_PREFIX;
+ my $vt_type = $PREFIX . $class->vtable_type;
+ $registrations
+ .= qq| ${prefix}VTable_add_to_registry($PREFIX|
+ . $class->vtable_var
+ . qq|);\n|;
+
+ my $parent = $class->get_parent;
+ next unless $parent;
+ my $parent_class = $parent->get_class_name;
+ my $class_name = $class->get_class_name;
+ $isa_pushes .= qq| isa = get_av("$class_name\::ISA", 1);\n|;
+ $isa_pushes .= qq| av_push(isa, newSVpv("$parent_class", 0));\n|;
+ }
+ my $filepath = catfile( $hierarchy->get_dest, $self->{boot_c_file} );
+ unlink $filepath;
+ sysopen( my $fh, $filepath, O_CREAT | O_EXCL | O_WRONLY )
+ or confess("Can't open '$filepath': $!");
+ print $fh <<END_STUFF;
+$self->{header}
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "$self->{boot_h_file}"
+#include "boil.h"
+$pound_includes
+
+void
+$self->{boot_func}()
+{
+ AV *isa;
+$registrations
+$isa_pushes
+}
+
+$self->{footer}
+
+END_STUFF
+}
+
+sub write_xs_typemap {
+ my $self = shift;
+ Boilerplater::Binding::Perl::TypeMap->write_xs_typemap(
+ hierarchy => $self->{hierarchy}, );
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Binding::Perl - Perl bindings for a Boilerplater::Hierarchy.
+
+=head1 DESCRIPTION
+
+Boilerplater::Binding::Perl presents an interface for auto-generating XS and
+Perl code to bind C code for a Boilerplater class hierarchy to Perl.
+
+In theory this module could be much more flexible and its API could be more
+elegant. There are many ways which you could walk the parsed parcels,
+classes, methods, etc. in a Boilerplater::Hierarchy and generate binding code.
+However, our needs are very limited, so we are content with a "one size fits
+one" solution.
+
+In particular, this module assumes that the XS bindings for all classes in the
+hierarchy should be assembled into a single shared object which belongs to the
+primary, "boot" class. There's no reason why it could not write one .xs file
+per class, or one per parcel, instead.
+
+The files written by this class are derived from the name of the boot class.
+If it is "Lucy", the following files will be generated.
+
+ # Generated by write_bindings()
+ $lib_dir/Lucy.xs
+ $lib_dir/Lucy/Autobinding.pm
+
+ # Generated by write_boot()
+ $hierarchy_dest_dir/lucy_boot.h
+ $hierarchy_dest_dir/lucy_boot.c
+
+=head1 METHODS
+
+=head2 new
+
+ my $perl_binding = Boilerplater::Binding::Perl->new(
+ boot_class => 'Lucy', # required
+ parcel => 'Lucy', # required
+ hierarchy => $hierarchy, # required
+ lib_dir => 'lib', # required
+ header => "/* Autogenerated file */\n", # required
+ footer => $copyfoot, # required
+ );
+
+=over
+
+=item * B<boot_class> - The name of the main class, which will own the shared
+object.
+
+=item * B<parcel> - The L<Boilerplater::Parcel> to which the C<boot_class>
+belongs.
+
+=item * B<hierarchy> - A Boilerplater::Hierarchy.
+
+=item * B<lib_dir> - location of the Perl lib directory to which files will be
+written.
+
+=item * B<header> - Text which will be prepended to generated C/XS files --
+typically, an "autogenerated file" warning.
+
+=item * B<footer> - Text to be appended to the end of generated C/XS files --
+typically copyright information.
+
+=back
+
+=head2 write_bindings
+
+ $perl_binding->write_bindings;
+
+Generate the XS bindings (including "Autobind.pm) for all classes in the
+hierarchy.
+
+=head2 prepare_pod
+
+ my $filepaths_and_pod = $perl_binding->prepare_pod;
+ while ( my ( $filepath, $pod ) = each %$filepaths_and_pod ) {
+ add_to_cleanup($filepath);
+ spew_file( $filepath, $pod );
+ }
+
+Auto-generate POD for all classes bindings which were spec'd with C<make_pod>
+directives. See whether a .pod file exists and is up to date.
+
+Return a hash representing POD files that need to be modified; the keys are
+filepaths, and the values are the POD file content.
+
+The caller must take responsibility for actually writing out the POD files,
+after adding the filepaths to cleanup records and so on.
+
+=head2 write_boot
+
+ $perl_binding->write_boot;
+
+Write out "boot" files to the Hierarchy's C<dest_dir> which contain code for
+bootstrapping Boilerplater classes.
+
+=head1 COPYRIGHT AND LICENSE
+
+ /**
+ * Copyright 2009 The Apache Software Foundation
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ * implied. See the License for the specific language governing
+ * permissions and limitations under the License.
+ */
+
+=cut
+
Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm
------------------------------------------------------------------------------
svn:eol-style = native
Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Class.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Class.pm?rev=811923&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Class.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Class.pm Sun Sep 6 22:18:16 2009
@@ -0,0 +1,468 @@
+use strict;
+use warnings;
+
+package Boilerplater::Binding::Perl::Class;
+use Boilerplater::Util qw( verify_args );
+
+our %registry;
+sub registry { \%registry }
+
+our %register_PARAMS = (
+ parcel => undef,
+ class_name => undef,
+ bind_methods => undef,
+ bind_constructors => undef,
+ make_pod => undef,
+ xs_code => undef,
+ client => undef,
+);
+
+sub register {
+ my $either = shift;
+ verify_args( \%register_PARAMS, @_ ) or confess $@;
+ my $self = bless { %register_PARAMS, @_, }, ref($either) || $either;
+
+ # Validate.
+ confess("Missing required param 'class_name'")
+ unless $self->{class_name};
+ confess("$self->{class_name} already registered")
+ if exists $registry{ $self->{class_name} };
+
+ # Retrieve Boilerplater::Class client, if it will be needed.
+ if ( $self->{bind_methods}
+ || $self->{bind_constructors}
+ || $self->{make_pod} )
+ {
+ $self->{client} = Boilerplater::Class->fetch_singleton(
+ parcel => $self->{parcel},
+ class_name => $self->{class_name},
+ );
+ confess("Can't fetch singleton for $self->{class_name}")
+ unless $self->{client};
+ }
+
+ # Add to registry.
+ $registry{ $self->{class_name} } = $self;
+
+ return $self;
+}
+
+sub get_class_name { shift->{class_name} }
+sub get_bind_methods { shift->{bind_methods} }
+sub get_bind_constructors { shift->{bind_constructors} }
+sub get_make_pod { shift->{make_pod} }
+sub get_client { shift->{client} }
+sub get_xs_code { shift->{xs_code} }
+
+sub constructor_bindings {
+ my $self = shift;
+ my @bound = map {
+ my $xsub = Boilerplater::Binding::Perl::Constructor->new(
+ class => $self->{client},
+ alias => $_,
+ );
+ } @{ $self->{bind_constructors} };
+ return @bound;
+}
+
+sub method_bindings {
+ my $self = shift;
+ my $client = $self->{client};
+ my $meth_list = $self->{bind_methods};
+ my @bound;
+
+ # Assemble a list of methods to be bound for this class.
+ my %meth_to_bind;
+ for my $meth_namespec (@$meth_list) {
+ my ( $alias, $name )
+ = $meth_namespec =~ /^(.*?)\|(.*)$/
+ ? ( $1, $2 )
+ : ( lc($meth_namespec), $meth_namespec );
+ $meth_to_bind{$name} = { alias => $alias };
+ }
+
+ # Iterate over all this class's methods, stopping to bind each one that
+ # was spec'd.
+ for my $method ( $client->methods ) {
+ my $meth_name = $method->get_macro_sym;
+ my $bind_args = delete $meth_to_bind{$meth_name};
+ next unless $bind_args;
+
+ # Safety checks against excess binding code or private methods.
+ if ( !$method->novel ) {
+ confess( "Binding spec'd for method '$meth_name' in class "
+ . "$self->{class_name}, but it's overridden and "
+ . "should be bound via the parent class" );
+ }
+ elsif ( $method->private ) {
+ confess( "Binding spec'd for method '$meth_name' in class "
+ . "$self->{class_name}, but it's private" );
+ }
+
+ # Create an XSub binding for each override. Each of these directly
+ # calls the implementing function, rather than invokes the method on
+ # the object using VTable method dispatch. Doing things this way
+ # allows SUPER:: invocations from Perl-space to work properly.
+ for my $descendant ( $client->tree_to_ladder ) { # includes self
+ my $real_method = $descendant->novel_method( lc($meth_name) );
+ next unless $real_method;
+
+ # Create the binding, add it to the array.
+ my $method_binding = Boilerplater::Binding::Perl::Method->new(
+ method => $real_method,
+ %$bind_args,
+ );
+ push @bound, $method_binding;
+ }
+ }
+
+ # Verify that we processed all methods.
+ my @leftover_meths = keys %meth_to_bind;
+ confess("Leftover for $self->{class_name}: '@leftover_meths'")
+ if @leftover_meths;
+
+ return @bound;
+}
+
+sub _gen_subroutine_pod {
+ my ( $self, %args ) = @_;
+ my ( $func, $sub_name, $class, $code_sample, $class_name )
+ = @args{qw( func name class sample class_name )};
+ my $param_list = $func->get_param_list;
+ my $args = "";
+ my $num_vars = $param_list->num_vars;
+
+ # Only allow "public" subs to be exposed as part of the public API.
+ confess("$class_name->$sub_name is not public") unless $func->public;
+
+ # Get documentation, which may be inherited.
+ my $docucom = $func->get_docucomment;
+ if ( !$docucom ) {
+ my $micro_sym = $func->micro_sym;
+ my $parent = $class;
+ while ( $parent = $parent->get_parent ) {
+ my $parent_func = $parent->method($micro_sym);
+ last unless $parent_func;
+ $docucom = $parent_func->get_docucomment;
+ last if $docucom;
+ }
+ }
+ confess("No DocuComment for '$sub_name' in '$class_name'")
+ unless $docucom;
+
+ # Build string summarizing arguments to use in header.
+ if ( $num_vars > 2 or ( $args{is_constructor} && $num_vars > 1 ) ) {
+ $args = " I<[labeled params]> ";
+ }
+ elsif ( $param_list->num_vars ) {
+ $args = $func->get_param_list->name_list;
+ $args =~ s/self.*?(?:,\s*|$)//; # kill self param
+ }
+
+ # Add code sample.
+ my $pod = "=head2 $sub_name($args)\n\n";
+ if ( defined($code_sample) && length($code_sample) ) {
+ $pod .= "$code_sample\n";
+ }
+
+ # Incorporate "description" text from DocuComment.
+ if ( my $long_doc = $docucom->get_description ) {
+ $pod .= _perlify_doc_text($long_doc) . "\n\n";
+ }
+
+ # Add params in a list.
+ my $param_names = $docucom->get_param_names;
+ my $param_docs = $docucom->get_param_docs;
+ if (@$param_names) {
+ $pod .= "=over\n\n";
+ for ( my $i = 0; $i <= $#$param_names; $i++ ) {
+ $pod .= "=item *\n\n";
+ $pod .= "B<$param_names->[$i]> - $param_docs->[$i]\n\n";
+ }
+ $pod .= "=back\n\n";
+ }
+
+ # Add return value description, if any.
+ if ( defined( my $retval = $docucom->get_retval ) ) {
+ $pod .= "Returns: $retval\n\n";
+ }
+
+ return $pod;
+}
+
+sub create_pod {
+ my $self = shift;
+ my $pod_args = $self->{make_pod} or return;
+ my $class = $self->{client} or die "No client for $self->{class_name}";
+ my $class_name = $class->get_class_name;
+ my $docucom = $class->get_docucomment;
+ confess("No DocuComment for '$class_name'") unless $docucom;
+ my $brief = $docucom->get_brief;
+ my $description = _perlify_doc_text( $pod_args->{description}
+ || $docucom->get_description );
+
+ # Create SYNOPSIS.
+ my $synopsis_pod = '';
+ if ( defined $pod_args->{synopsis} ) {
+ $synopsis_pod = qq|=head1 SYNOPSIS\n\n$pod_args->{synopsis}\n|;
+ }
+
+ # Create CONSTRUCTORS.
+ my $constructor_pod = "";
+ my $constructors = $pod_args->{constructors} || [];
+ if ( defined $pod_args->{constructor} ) {
+ push @$constructors, $pod_args->{constructor};
+ }
+ if (@$constructors) {
+ $constructor_pod = "=head1 CONSTRUCTORS\n\n";
+ for my $spec (@$constructors) {
+ if ( !ref $spec ) {
+ $constructor_pod .= _perlify_doc_text($spec);
+ }
+ else {
+ my $func_name = $spec->{func} || 'init';
+ my $init_func = $class->function($func_name);
+ my $ctor_name = $spec->{name} || 'new';
+ my $code_sample = $spec->{sample};
+ $constructor_pod .= _perlify_doc_text(
+ $self->_gen_subroutine_pod(
+ func => $init_func,
+ name => $ctor_name,
+ sample => $code_sample,
+ class => $class,
+ class_name => $class_name,
+ is_constructor => 1,
+ )
+ );
+ }
+ }
+ }
+
+ # Create METHODS, possibly including an ABSTRACT METHODS section.
+ my @method_docs;
+ my $methods_pod = "";
+ my @abstract_method_docs;
+ my $abstract_methods_pod = "";
+ for my $spec ( @{ $pod_args->{methods} } ) {
+ my $meth_name = ref($spec) ? $spec->{name} : $spec;
+ my $method = $class->method($meth_name);
+ confess("Can't find method '$meth_name' in class '$class_name'")
+ unless $method;
+ my $method_pod;
+ if ( ref($spec) ) {
+ $method_pod = $spec->{pod};
+ }
+ else {
+ $method_pod = $self->_gen_subroutine_pod(
+ func => $method,
+ name => $meth_name,
+ sample => '',
+ class => $class,
+ class_name => $class_name
+ );
+ }
+ if ( $method->abstract ) {
+ push @abstract_method_docs, _perlify_doc_text($method_pod);
+ }
+ else {
+ push @method_docs, _perlify_doc_text($method_pod);
+ }
+ }
+ if (@method_docs) {
+ $methods_pod = join( "", "=head1 METHODS\n\n", @method_docs );
+ }
+ if (@abstract_method_docs) {
+ $abstract_methods_pod = join( "", "=head1 ABSTRACT METHODS\n\n",
+ @abstract_method_docs );
+ }
+
+ # Build an INHERITANCE section describing class ancestry.
+ my $child = $class;
+ my @ancestors;
+ while ( defined( my $parent = $child->get_parent ) ) {
+ push @ancestors, $parent;
+ $child = $parent;
+ }
+ my $inheritance_pod = "";
+ if (@ancestors) {
+ $inheritance_pod = "=head1 INHERITANCE\n\n";
+ $inheritance_pod .= $class->get_class_name;
+ for my $ancestor (@ancestors) {
+ $inheritance_pod .= " isa L<" . $ancestor->get_class_name . ">";
+ }
+ $inheritance_pod .= ".\n";
+ }
+
+ # Put it all together.
+ my $pod = <<END_POD;
+
+# Auto-generated file -- DO NOT EDIT!!!!!
+
+==head1 NAME
+
+$class_name - $brief
+
+$synopsis_pod
+
+==head1 DESCRIPTION
+
+$description
+
+$constructor_pod
+
+$methods_pod
+
+$abstract_methods_pod
+
+$inheritance_pod
+
+==head1 COPYRIGHT AND LICENSE
+
+Copyright 2005-2009 Marvin Humphrey
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+==cut
+
+END_POD
+
+ # Kill off stupid hack which allows us to embed pod in this file without
+ # messing up what you see when you perldoc it.
+ $pod =~ s/^==/=/gm;
+
+ return $pod;
+}
+
+sub _perlify_doc_text {
+ my $documentation = shift;
+
+ # Remove double-equals hack needed to fool perldoc, PAUSE, etc. :P
+ $documentation =~ s/^==/=/mg;
+
+ # Change <code>foo</code> to C<< foo >>.
+ $documentation =~ s#<code>(.*?)</code>#C<< $1 >>#gsm;
+
+ # Lowercase all method names: Open_In() => open_in()
+ $documentation
+ =~ s/([A-Z][A-Za-z0-9]*(?:_[A-Z][A-Za-z0-9]*)*\(\))/\L$1\E/gsm;
+
+ # Change all instances of NULL to 'undef'
+ $documentation =~ s/NULL/undef/g;
+
+ return $documentation;
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Binding::Perl::Class - Generate Perl binding code for a
+Boilerplater::Class.
+
+=head1 CLASS METHODS
+
+=head1 register
+
+ Boilerplater::Binding::Perl::Class->register(
+ parcel => 'Boil', # required
+ class_name => 'Foo::FooJr', # required
+ bind_methods => [qw( Do_Stuff _get_foo|Get_Foo )], # default: undef
+ bind_constructors => [qw( new _new2|init2 )], # default: undef
+ make_pod => [qw( get_foo )], # default: undef
+ xs_code => undef, # default: undef
+ );
+
+Create a new class binding and lodge it in the registry. May only be called
+once for each unique class name, and must be called after all classes have
+been parsed (via Boilerplater::Hierarchy's build()).
+
+=over
+
+=item * B<parcel> - A L<Boilerplater::Parcel> or parcel name.
+
+=item * B<class_name> - The name of the class to be registered.
+
+=item * B<xs_code> - Raw XS code to be included in the final .xs file
+generated by Boilerplater::Binding::Perl. The XS directives PACKAGE and
+MODULE should be specified.
+
+=item * B<bind_methods> - An array of names for novel methods for which XS
+bindings should be auto-generated, supplied using Boilerplater's C<Macro_Name>
+method-naming convention. The Perl subroutine name will be derived by
+lowercasing C<Method_Name> to C<method_name>, but this can be overridden by
+prepending an alias and a pipe: e.g. C<_get_foo|Get_Foo>.
+
+=item * B<bind_constructors> - An array of constructor names. The default
+implementing function is the class's C<init> function, unless it is overridden
+using a pipe-separated string: C<_new2|init2> would create a Perl subroutine
+"_new2" which would invoke C<boil_FooJr_init2>.
+
+=item * B<make_pod> - A specification for generating POD. TODO: document this
+spec, or break it up into multiple methods. (For now, just see examples from
+the source code.)
+
+=back
+
+=head1 registry
+
+ my $registry = Boilerplater::Binding::Perl::Class->registry;
+ while ( my $class_name, $class_binding ) = each %$registry ) {
+ ...
+ }
+
+Return the hash registry used by register(). The keys are class names, and
+the values are Boilerplater::Binding::Perl::Class objects.
+
+=head1 OBJECT METHODS
+
+=head2 get_class_name get_bind_methods get_bind_methods get_make_pod
+get_xs_code get_client
+
+Accessors. C<get_client> retrieves the Boilerplater::Class module to be
+bound.
+
+=head2 constructor_bindings
+
+ my @ctor_bindings = $class_binding->constructor_bindings;
+
+Return a list of Boilerplater::Binding::Perl::Constructor objects created as
+per the C<bind_constructors> spec.
+
+=head2 method_bindings
+
+ my @method_bindings = $class_binding->method_bindings;
+
+Return a list of Boilerplater::Binding::Perl::Method objects created as per
+the C<bind_methods> spec.
+
+=head2 create_pod
+
+ my $pod = $class_binding->create_pod;
+
+Auto-generate POD according to the make_pod spec, if such a spec was supplied.
+
+=head1 COPYRIGHT AND LICENSE
+
+ /**
+ * Copyright 2009 The Apache Software Foundation
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ * implied. See the License for the specific language governing
+ * permissions and limitations under the License.
+ */
+
+=cut
+
Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Class.pm
------------------------------------------------------------------------------
svn:eol-style = native
Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Constructor.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Constructor.pm?rev=811923&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Constructor.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Constructor.pm Sun Sep 6 22:18:16 2009
@@ -0,0 +1,199 @@
+use strict;
+use warnings;
+
+package Boilerplater::Binding::Perl::Constructor;
+use base qw( Boilerplater::Binding::Perl::Subroutine );
+use Carp;
+use Boilerplater::Binding::Perl::TypeMap qw( from_perl );
+use Boilerplater::ParamList;
+
+sub new {
+ my ( $either, %args ) = @_;
+ my $class = delete $args{class};
+ my $alias = delete $args{alias};
+ my $init_func_name = $alias =~ s/^(\w+)\|(\w+)$/$1/ ? $2 : 'init';
+ my $class_name = $class->get_class_name;
+
+ # Find the implementing function.
+ my $func;
+ for my $function ( $class->functions ) {
+ next unless $function->micro_sym eq $init_func_name;
+ $func = $function;
+ last;
+ }
+ confess("Missing or invalid init() function for $class_name")
+ unless $func;
+
+ my $self = $either->SUPER::new(
+ param_list => $func->get_param_list,
+ retval_type => $func->get_return_type,
+ class_name => $class_name,
+ use_labeled_params => 1,
+ alias => $alias,
+ %args
+ );
+ $self->{init_func} = $func;
+ return $self;
+}
+
+sub xsub_def {
+ my $self = shift;
+ my $c_name = $self->c_name;
+ my $param_list = $self->{param_list};
+ my $name_list = $param_list->name_list;
+ my $arg_inits = $param_list->get_initial_values;
+ my $num_args = $param_list->num_vars;
+ my $arg_vars = $param_list->get_variables;
+ my $func_sym = $self->{init_func}->full_func_sym;
+
+ # Create code for allocating labeled parameters.
+ my $var_declarations = $self->var_declarations;
+ my $params_hash_name = $self->perl_name . "_PARAMS";
+ my @var_assignments;
+ my @refcount_mods;
+ my $allot_params
+ = qq|XSBind_allot_params( &(ST(0)), 1, items, "$params_hash_name",\n|;
+
+ # Iterate over args in param list.
+ for ( my $i = 1; $i <= $#$arg_vars; $i++ ) {
+ my $var = $arg_vars->[$i];
+ my $val = $arg_inits->[$i];
+ my $name = $var->micro_sym;
+ my $sv_name = $name . "_sv";
+ my $stack_name = $name . "_zcb";
+ my $type = $var->get_type;
+ my $len = length $name;
+
+ # Create snippet for extracting sv from stack, if supplied.
+ $allot_params .= qq| &$sv_name, "$name", $len,\n|;
+
+ # Create code for determining and validating value.
+ my $statement = from_perl( $type, $name, $sv_name, $stack_name );
+ if ( defined $val ) {
+ my $assignment = qq|if ($sv_name && XSBind_sv_defined($sv_name)) {
+ $statement
+ }
+ else {
+ $name = $val;
+ }|;
+ push @var_assignments, $assignment;
+ }
+ else {
+ my $assignment
+ = qq#if ( !$sv_name || !XSBind_sv_defined($sv_name) ) {
+ THROW(LUCY_ERR, "Missing required param '$name'");
+ }
+ $statement#;
+ push @var_assignments, $assignment;
+ }
+
+ # Compensate for the fact that the method will swallow a refcount.
+ if ( $type->is_object and $type->decremented ) {
+ push @refcount_mods, "if ($name) { LUCY_INCREF($name); }";
+ }
+ }
+ $allot_params .= " NULL);\n";
+
+ # Last, so that earlier exceptions while fetching params don't trigger bad
+ # DESTROY.
+ my $self_var = $arg_vars->[0];
+ my $self_type = $self_var->get_type->to_c;
+ push @var_assignments,
+ qq|self = ($self_type)XSBind_new_blank_obj( ST(0) );|;
+
+ # Bundle up variable assignment statments.
+ my $var_assignments
+ = join( "\n ", $allot_params, @var_assignments );
+ my $refcount_mods = join( "\n ", @refcount_mods );
+
+ return <<END_STUFF;
+XS($c_name); /* -Wmissing-prototypes */
+XS($c_name)
+{
+ dXSARGS;
+ CHY_UNUSED_VAR(cv);
+ CHY_UNUSED_VAR(ax);
+ if (items < 1)
+ THROW(LUCY_ERR, "Usage: %s(class_name, ...)", GvNAME(CvGV(cv)));
+ SP -= items;
+
+ {
+ $var_declarations
+ $var_assignments
+ $refcount_mods
+ retval = $func_sym($name_list);
+ ST(0) = Lucy_Obj_To_Host(retval);
+ LUCY_DECREF(retval);
+ sv_2mortal( ST(0) );
+ XSRETURN(1);
+ }
+
+ PUTBACK;
+}
+
+END_STUFF
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Binding::Perl::Constructor - Binding for an object method.
+
+=head1 DESCRIPTION
+
+This class isa Boilerplater::Binding::Perl::Subroutine -- see its
+documentation for various code-generating routines.
+
+Constructors are always bound to accept labeled params, even if there is only
+a single argument.
+
+=head1 METHODS
+
+=head2 new
+
+ my $constructor_binding = Boilerplater::Binding::Perl::Constructor->new(
+ class => $class,
+ alias => "_new|init2",
+ );
+
+=over
+
+=item * B<class> - A L<Boilerplater::Class>.
+
+=item * B<alias> - A specifier for the name of the constructor, and
+optionally, a specifier for the implementing function. If C<alias> has a pipe
+character in it, the text to the left of the pipe will be used as the Perl
+alias, and the text to the right will be used to determine which C function
+should be bound. The default function is "init".
+
+=back
+
+=head2 xsub_def
+
+Generate the XSUB code.
+
+=head1 COPYRIGHT AND LICENSE
+
+ /**
+ * Copyright 2009 The Apache Software Foundation
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ * implied. See the License for the specific language governing
+ * permissions and limitations under the License.
+ */
+
+=cut
+
Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Constructor.pm
------------------------------------------------------------------------------
svn:eol-style = native
Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Method.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Method.pm?rev=811923&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Method.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Method.pm Sun Sep 6 22:18:16 2009
@@ -0,0 +1,336 @@
+use strict;
+use warnings;
+
+package Boilerplater::Binding::Perl::Method;
+use base qw( Boilerplater::Binding::Perl::Subroutine );
+use Boilerplater::Util qw( verify_args );
+use Boilerplater::Binding::Perl::TypeMap qw( from_perl to_perl );
+use Carp;
+
+our %new_PARAMS = (
+ method => undef,
+ alias => undef,
+);
+
+sub new {
+ my ( $either, %args ) = @_;
+ confess $@ unless verify_args( \%new_PARAMS, %args );
+
+ # Derive arguments to SUPER constructor from supplied Method.
+ my $method = delete $args{method};
+ $args{retval_type} ||= $method->get_return_type;
+ $args{param_list} ||= $method->get_param_list;
+ $args{alias} ||= $method->micro_sym;
+ $args{class_name} ||= $method->get_class_name;
+ if ( !defined $args{use_labeled_params} ) {
+ $args{use_labeled_params}
+ = $method->get_param_list->num_vars > 2
+ ? 1
+ : 0;
+ }
+ my $self = $either->SUPER::new(%args);
+ $self->{method} = $method;
+
+ return $self;
+}
+
+sub xsub_def {
+ my $self = shift;
+ if ( $self->{use_labeled_params} ) {
+ return $self->_xsub_def_labeled_params;
+ }
+ else {
+ return $self->_xsub_def_positional_args;
+ }
+}
+
+# Build XSUB function body.
+sub _xsub_body {
+ my $self = shift;
+ my $method = $self->{method};
+ my $full_func_sym = $method->full_func_sym;
+ my $param_list = $method->get_param_list;
+ my $arg_vars = $param_list->get_variables;
+ my $name_list = $param_list->name_list;
+ my $body = "";
+
+ # Compensate for functions which eat refcounts.
+ for my $arg_var (@$arg_vars) {
+ my $arg_type = $arg_var->get_type;
+ next unless $arg_type->is_object;
+ next unless $arg_type->decremented;
+ my $var_name = $arg_var->micro_sym;
+ $body .= "if ($var_name) (void)LUCY_INCREF($var_name);\n ";
+ }
+
+ if ( $method->void ) {
+ # Invoke method in void context.
+ $body .= qq|$full_func_sym($name_list);|;
+ }
+ else {
+ # Return a value for method invoked in a scalar context.
+ my $return_type = $method->get_return_type;
+ my $retval_assignment = to_perl( $return_type, 'ST(0)', 'retval' );
+ my $decrement = "";
+ if ( $return_type->is_object and $return_type->incremented ) {
+ $decrement = "LUCY_DECREF(retval);\n";
+ }
+ $body .= qq|retval = $full_func_sym($name_list);
+ $retval_assignment$decrement
+ sv_2mortal( ST(0) );
+ XSRETURN(1);|
+ }
+
+ return $body;
+}
+
+sub _xsub_def_positional_args {
+ my $self = shift;
+ my $method = $self->{method};
+ my $param_list = $method->get_param_list;
+ my $arg_vars = $param_list->get_variables;
+ my $arg_inits = $param_list->get_initial_values;
+ my $num_args = $param_list->num_vars;
+ my $c_name = $self->c_name;
+ my $body = $self->_xsub_body;
+
+ # Determine how many args are truly required and build an error check.
+ my $min_required = $num_args;
+ while ( defined $arg_inits->[ $min_required - 1 ] ) {
+ $min_required--;
+ }
+ my @xs_arg_names;
+ for ( my $i = 0; $i < $min_required; $i++ ) {
+ push @xs_arg_names, $arg_vars->[$i]->micro_sym;
+ }
+ my $xs_name_list = join( ", ", @xs_arg_names );
+ my $num_args_check;
+ if ( $min_required < $num_args ) {
+ $num_args_check
+ = qq|if (items < $min_required) { |
+ . qq|THROW(LUCY_ERR, "Usage: %s(%s)", GvNAME(CvGV(cv)),|
+ . qq| "$xs_name_list"); }|;
+ }
+ else {
+ $num_args_check
+ = qq|if (items != $num_args) { |
+ . qq| THROW(LUCY_ERR, "Usage: %s(%s)", GvNAME(CvGV(cv)), |
+ . qq|"$xs_name_list"); }|;
+ }
+
+ # Var assignments.
+ my $var_declarations = $self->var_declarations;
+ my @var_assignments;
+ for ( my $i = 0; $i < @$arg_vars; $i++ ) {
+ my $var = $arg_vars->[$i];
+ my $val = $arg_inits->[$i];
+ my $var_name = $var->micro_sym;
+ my $stack_name = $var_name . '_zcb';
+ my $var_type = $var->get_type;
+ my $statement;
+ if ( $i == 0 ) { # $self
+ $statement
+ = _self_assign_statement( $var_type, $method->micro_sym );
+ }
+ else {
+ $statement
+ = from_perl( $var_type, $var_name, "ST($i)", $stack_name );
+ }
+ if ( defined $val ) {
+ $statement
+ = qq| if ( items >= $i && XSBind_sv_defined(ST($i)) ) {
+ $statement
+ }
+ else {
+ $var_name = $val;
+ }|;
+ }
+ push @var_assignments, $statement;
+ }
+ my $var_assignments = join "\n ", @var_assignments;
+
+ return <<END_STUFF;
+XS($c_name); /* -Wmissing-prototypes */
+XS($c_name)
+{
+ dXSARGS;
+ CHY_UNUSED_VAR(cv);
+ CHY_UNUSED_VAR(ax);
+ SP -= items;
+ $num_args_check;
+
+ {
+ /* Extract vars from Perl stack. */
+ $var_declarations
+ $var_assignments
+
+ /* Execute */
+ $body
+ }
+
+ PUTBACK;
+}
+END_STUFF
+}
+
+sub _xsub_def_labeled_params {
+ my $self = shift;
+ my $c_name = $self->c_name;
+ my $param_list = $self->{param_list};
+ my $arg_inits = $param_list->get_initial_values;
+ my $num_args = $param_list->num_vars;
+ my $arg_vars = $param_list->get_variables;
+ my $body = $self->_xsub_body;
+
+ # Prepare error message for incorrect args.
+ my $name_list = $arg_vars->[0]->micro_sym . ", ...";
+ my $num_args_check
+ = qq|if (items < 1) { |
+ . qq|THROW(LUCY_ERR, "Usage: %s(%s)", GvNAME(CvGV(cv)), |
+ . qq|"$name_list"); }|;
+
+ # Create code for allocating labeled parameters.
+ my $var_declarations = $self->var_declarations;
+ my $self_var = $arg_vars->[0];
+ my $self_type = $self_var->get_type;
+ my $params_hash_name = $self->perl_name . "_PARAMS";
+ my $self_assignment
+ = _self_assign_statement( $self_type, $self->{method}->micro_sym );
+ my @var_assignments;
+ my $allot_params
+ = qq|XSBind_allot_params( &(ST(0)), 1, items, "$params_hash_name", |;
+
+ # Iterate over args in param list.
+ for ( my $i = 1; $i <= $#$arg_vars; $i++ ) {
+ my $var = $arg_vars->[$i];
+ my $val = $arg_inits->[$i];
+ my $name = $var->micro_sym;
+ my $sv_name = $name . "_sv";
+ my $stack_name = $name . "_zcb";
+ my $type = $var->get_type;
+ my $len = length $name;
+
+ # Code for extracting sv from stack, if supplied.
+ $allot_params .= qq| &$sv_name, "$name", $len,\n|;
+
+ # Code for determining and validating value.
+ my $statement = from_perl( $type, $name, $sv_name, $stack_name );
+ if ( defined $val ) {
+ my $assignment
+ = qq|if ( $sv_name && XSBind_sv_defined($sv_name) ) {
+ $statement;
+ }
+ else {
+ $name = $val;
+ }|;
+ push @var_assignments, $assignment;
+ }
+ else {
+ my $assignment
+ = qq#if ( !$sv_name || !XSBind_sv_defined($sv_name) ) { #
+ . qq#THROW(LUCY_ERR, "Missing required param '$name'"); }\n#
+ . qq# $statement;#;
+ push @var_assignments, $assignment;
+ }
+ }
+ $allot_params .= " NULL);\n";
+ my $var_assignments = join( "\n ",
+ $self_assignment, $allot_params, @var_assignments, );
+
+ return <<END_STUFF;
+XS($c_name); /* -Wmissing-prototypes */
+XS($c_name)
+{
+ dXSARGS;
+ CHY_UNUSED_VAR(cv);
+ CHY_UNUSED_VAR(ax);
+ $num_args_check;
+ SP -= items;
+
+ {
+ /* Extract vars from Perl stack. */
+ $var_declarations
+ $var_assignments
+
+ /* Execute */
+ $body
+ }
+
+ PUTBACK;
+}
+END_STUFF
+}
+
+# Create an assignment statement for extracting $self from the Perl stack.
+sub _self_assign_statement {
+ my ( $type, $method_name ) = @_;
+ my $type_c = $type->to_c;
+ $type_c =~ /(\w+)\*$/ or die "Not an object type: $type_c";
+ my $vtable = uc($1);
+
+ # Make an exception for deserialize -- allow self to be NULL if called as
+ # a class method.
+ my $binding_func
+ = $method_name eq 'deserialize'
+ ? 'XSBind_maybe_sv_to_lucy_obj'
+ : 'XSBind_sv_to_lucy_obj';
+ return "self = ($type_c)$binding_func(ST(0), $vtable, NULL);";
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Binding::Perl::Method - Binding for an object method.
+
+=head1 DESCRIPTION
+
+This class isa Boilerplater::Binding::Perl::Subroutine -- see its
+documentation for various code-generating routines.
+
+Method bindings use labeled parameters if the C function takes more than one
+argument (other than C<self>). If there is only one argument, the binding
+will be set up to accept a single positional argument.
+
+=head1 METHODS
+
+=head2 new
+
+ my $binding = Boilerplater::Binding::Perl::Method->new(
+ method => $method, # required
+ );
+
+=over
+
+=item * B<method> - A L<Boilerplater::Method>.
+
+=back
+
+=head2 xsub_def
+
+Generate the XSUB code.
+
+=head1 COPYRIGHT AND LICENSE
+
+ /**
+ * Copyright 2009 The Apache Software Foundation
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ * implied. See the License for the specific language governing
+ * permissions and limitations under the License.
+ */
+
+=cut
+
Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Method.pm
------------------------------------------------------------------------------
svn:eol-style = native
Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Subroutine.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Subroutine.pm?rev=811923&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Subroutine.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Subroutine.pm Sun Sep 6 22:18:16 2009
@@ -0,0 +1,218 @@
+use strict;
+use warnings;
+
+package Boilerplater::Binding::Perl::Subroutine;
+use Carp;
+use Boilerplater::Class;
+use Boilerplater::Function;
+use Boilerplater::Method;
+use Boilerplater::Variable;
+use Boilerplater::ParamList;
+use Boilerplater::Util qw( verify_args );
+
+our %new_PARAMS = (
+ param_list => undef,
+ alias => undef,
+ class_name => undef,
+ retval_type => undef,
+ use_labeled_params => undef,
+);
+
+sub new {
+ my $either = shift;
+ verify_args( \%new_PARAMS, @_ ) or confess $@;
+ my $self = bless { %new_PARAMS, @_, }, ref($either) || $either;
+ for (qw( param_list class_name alias retval_type )) {
+ confess("$_ is required") unless defined $self->{$_};
+ }
+ return $self;
+}
+
+sub get_class_name { shift->{class_name} }
+sub use_labeled_params { shift->{use_labeled_params} }
+
+sub perl_name {
+ my $self = shift;
+ return "$self->{class_name}::$self->{alias}";
+}
+
+sub c_name {
+ my $self = shift;
+ my $c_name = "XS_" . $self->perl_name;
+ $c_name =~ s/:+/_/g;
+ return $c_name;
+}
+
+sub c_name_list {
+ my $self = shift;
+ return $self->{param_list}->name_list;
+}
+
+my %params_hash_vals_map = (
+ NULL => 'undef',
+ true => 1,
+ false => 0,
+);
+
+sub params_hash_def {
+ my $self = shift;
+ return unless $self->{use_labeled_params};
+
+ my $params_hash_name = $self->perl_name . "_PARAMS";
+ my $arg_vars = $self->{param_list}->get_variables;
+ my $vals = $self->{param_list}->get_initial_values;
+ my @pairs;
+ for ( my $i = 1; $i < @$arg_vars; $i++ ) {
+ my $var = $arg_vars->[$i];
+ my $val = $vals->[$i];
+ if ( !defined $val ) {
+ $val = 'undef';
+ }
+ elsif ( exists $params_hash_vals_map{$val} ) {
+ $val = $params_hash_vals_map{$val};
+ }
+ push @pairs, $var->micro_sym . " => $val,";
+ }
+
+ if (@pairs) {
+ my $list = join( "\n ", @pairs );
+ return qq|\%$params_hash_name = (\n $list\n);\n|;
+ }
+ else {
+ return qq|\%$params_hash_name = ();\n|;
+ }
+}
+
+sub var_declarations {
+ my $self = shift;
+ my $arg_vars = $self->{param_list}->get_variables;
+ my @var_declarations;
+ for my $i ( 0 .. $#$arg_vars ) {
+ my $arg_var = $arg_vars->[$i];
+ push @var_declarations, $arg_var->local_declaration;
+ next if $i == 0; # no ZombieCharBuf for $self.
+ next
+ unless $arg_var->get_type->get_specifier
+ =~ /^lucy_(Obj|CharBuf)$/;
+ push @var_declarations,
+ 'lucy_ZombieCharBuf '
+ . $arg_var->micro_sym
+ . '_zcb = LUCY_ZCB_BLANK;';
+ }
+ if ( !$self->{retval_type}->is_void ) {
+ my $return_type = $self->{retval_type}->to_c;
+ push @var_declarations, "$return_type retval;";
+ }
+ if ( $self->{use_labeled_params} ) {
+ push @var_declarations,
+ map { "SV* " . $_->micro_sym . "_sv = NULL;" }
+ @$arg_vars[ 1 .. $#$arg_vars ];
+ }
+ return join( "\n ", @var_declarations );
+}
+
+sub xsub_def { confess "Abstract method" }
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Binding::Perl::Subroutine - Abstract base binding for a
+Boilerplater::Function.
+
+=head1 SYNOPSIS
+
+ # Abstract base class.
+
+=head1 DESCRIPTION
+
+This class is used to generate binding code for invoking Boilerplater's
+functions and methods across the Perl/C barrier.
+
+=head1 METHODS
+
+=head2 new
+
+ my $binding = $subclass->SUPER::new(
+ param_list => $param_list, # required
+ alias => 'do_stuff', # required
+ class_name => 'Foo::FooJr', # required
+ retval_type => $type, # required
+ use_labeled_params => 1, # default: false
+ );
+
+Abstract constructor.
+
+=over
+
+=item * B<param_list> - A L<Boilerplater::ParamList>.
+
+=item * B<alias> - The local, unqualified name for the Perl subroutine that
+will be used to invoke the function.
+
+=item * B<class_name> - The name of the Perl class that the subroutine belongs
+to.
+
+=item * B<retval_type> - The return value's L<Type|Boilerplater::Type>.
+
+=item * B<use_labeled_params> - True if the binding should take hash-style
+labeled parameters, false if it should take positional arguments.
+
+=back
+
+=head2 xsub_def
+
+Abstract method which must return C code (not XS code) defining the Perl XSUB.
+
+=head2 var_declarations
+
+Generate C code containing declarations for subroutine-specific automatic
+variables needed by the XSUB.
+
+=head2 get_class_name use_labeled_params
+
+Accessors.
+
+=head2 perl_name
+
+Returns the fully-qualified perl sub name.
+
+=head2 c_name
+
+Returns the fully-qualified name of the C function that implements the XSUB.
+
+=head2 c_name_list
+
+Returns a string containing the names of arguments to feed to bound C
+function, joined by commas.
+
+=head2 params_hash_def
+
+Return Perl code initializing a package-global hash where all the keys are the
+names of labeled params. The hash's name consists of the the binding's
+perl_name() plus "_PARAMS".
+
+=head1 COPYRIGHT AND LICENSE
+
+ /**
+ * Copyright 2009 The Apache Software Foundation
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ * implied. See the License for the specific language governing
+ * permissions and limitations under the License.
+ */
+
+=cut
+
Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/Subroutine.pm
------------------------------------------------------------------------------
svn:eol-style = native
Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/TypeMap.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/TypeMap.pm?rev=811923&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/TypeMap.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/TypeMap.pm Sun Sep 6 22:18:16 2009
@@ -0,0 +1,378 @@
+use strict;
+use warnings;
+
+package Boilerplater::Binding::Perl::TypeMap;
+use base qw( Exporter );
+use Scalar::Util qw( blessed );
+use Carp;
+use Fcntl;
+use Config;
+
+our @EXPORT_OK = qw( from_perl to_perl );
+
+# Convert from a Perl scalar to a primitive type.
+my %primitives_from_perl = (
+ double => sub {"$_[0] = SvNV( $_[1] );"},
+ float => sub {"$_[0] = (float)SvNV( $_[1] );"},
+ int => sub {"$_[0] = (int)SvIV( $_[1] );"},
+ short => sub {"$_[0] = (short)SvIV( $_[1] );"},
+ long => sub {
+ $Config{longsize} <= $Config{ivsize}
+ ? "$_[0] = (long)SvIV( $_[1] );"
+ : "$_[0] = (long)SvNV( $_[1] );";
+ },
+ size_t => sub {"$_[0] = (size_t)SvIV( $_[1] );"},
+ chy_u64_t => sub {"$_[0] = (chy_u64_t)SvNV( $_[1] );"},
+ chy_u32_t => sub {"$_[0] = (chy_u32_t)SvUV( $_[1] );"},
+ chy_u16_t => sub {"$_[0] = (chy_u16_t)SvUV( $_[1] );"},
+ chy_u8_t => sub {"$_[0] = (chy_u8_t)SvUV( $_[1] );"},
+ chy_i64_t => sub {"$_[0] = (chy_i64_t)SvNV( $_[1] );"},
+ chy_i32_t => sub {"$_[0] = (chy_i32_t)SvIV( $_[1] );"},
+ chy_i16_t => sub {"$_[0] = (chy_i16_t)SvIV( $_[1] );"},
+ chy_i8_t => sub {"$_[0] = (chy_i8_t)SvIV( $_[1] );"},
+ chy_bool_t => sub {"$_[0] = SvTRUE( $_[1] ) ? 1 : 0;"},
+);
+
+# Convert from a primitive type to a Perl scalar.
+my %primitives_to_perl = (
+ double => sub {"$_[0] = newSVnv( $_[1] );"},
+ float => sub {"$_[0] = newSVnv( $_[1] );"},
+ int => sub {"$_[0] = newSViv( $_[1] );"},
+ short => sub {"$_[0] = newSViv( $_[1] );"},
+ long => sub {
+ $Config{longsize} <= $Config{ivsize}
+ ? "$_[0] = newSViv( $_[1] );"
+ : "$_[0] = newSVnv( (NV)$_[1] );";
+ },
+ size_t => sub {"$_[0] = newSViv( $_[1] );"},
+ chy_u64_t => sub {
+ $Config{uvsize} == 8
+ ? "$_[0] = newSVuv( $_[1] );"
+ : "$_[0] = newSVnv( (NV)$_[1] );";
+ },
+ chy_u32_t => sub {"$_[0] = newSVuv( $_[1] );"},
+ chy_u16_t => sub {"$_[0] = newSVuv( $_[1] );"},
+ chy_u8_t => sub {"$_[0] = newSVuv( $_[1] );"},
+ chy_i64_t => sub {
+ $Config{ivsize} == 8
+ ? "$_[0] = newSViv( $_[1] );"
+ : "$_[0] = newSVnv( (NV)$_[1] );";
+ },
+ chy_i32_t => sub {"$_[0] = newSViv( $_[1] );"},
+ chy_i16_t => sub {"$_[0] = newSViv( $_[1] );"},
+ chy_i8_t => sub {"$_[0] = newSViv( $_[1] );"},
+ chy_bool_t => sub {"$_[0] = newSViv( $_[1] );"},
+);
+
+# Extract a Boilerplater object from a Perl SV.
+sub _sv_to_bp_obj {
+ my ( $type, $bp_var, $xs_var, $stack_var ) = @_;
+ my $struct_sym = $type->get_specifier;
+ my $vtable = uc($struct_sym);
+ my $third_arg;
+ if ( $struct_sym =~ /^[a-z_]*(Obj|CharBuf)$/ ) {
+ # Share buffers rather than copy between Perl scalars and BP string
+ # types. Assume that the appropriate ZombieCharBuf has been declared
+ # on the stack.
+ $third_arg = "&$stack_var";
+ }
+ else {
+ $third_arg = 'NULL';
+ }
+ return "$bp_var = ($struct_sym*)XSBind_sv_to_lucy_obj($xs_var, "
+ . "$vtable, $third_arg);";
+}
+
+sub _void_star_to_lucy {
+ my ( $type, $bp_var, $xs_var ) = @_;
+ # Assume that void* is a reference SV -- either a hashref or an arrayref.
+ return qq|if (SvROK($xs_var)) {
+ $bp_var = SvRV($xs_var);
+ }
+ else {
+ $bp_var = NULL; /* avoid uninitialized compiler warning */
+ LUCY_THROW(LUCY_ERR, "$bp_var is not a reference");
+ }\n|;
+}
+
+sub from_perl {
+ my ( $type, $bp_var, $xs_var, $stack_var ) = @_;
+ confess("Not a Boilerplater::Type")
+ unless blessed($type) && $type->isa('Boilerplater::Type');
+
+ if ( $type->is_object ) {
+ return _sv_to_bp_obj( $type, $bp_var, $xs_var, $stack_var );
+ }
+ elsif ( $type->is_primitive ) {
+ if ( my $sub = $primitives_from_perl{ $type->to_c } ) {
+ return $sub->( $bp_var, $xs_var );
+ }
+ }
+ elsif ( $type->is_composite ) {
+ if ( $type->to_c eq 'void*' ) {
+ return _void_star_to_lucy( $type, $bp_var, $xs_var );
+ }
+ }
+
+ confess( "Missing typemap for " . $type->to_c );
+}
+
+sub to_perl {
+ my ( $type, $xs_var, $bp_var ) = @_;
+ confess("Not a Boilerplater::Type")
+ unless ref($type) && $type->isa('Boilerplater::Type');
+ my $type_str = $type->to_c;
+
+ if ( $type->is_object ) {
+ return "$xs_var = $bp_var == NULL ? newSV(0) : "
+ . "XSBind_lucy_to_perl((lucy_Obj*)$bp_var);";
+ }
+ elsif ( $type->is_primitive ) {
+ if ( my $sub = $primitives_to_perl{$type_str} ) {
+ return $sub->( $xs_var, $bp_var );
+ }
+ }
+ elsif ( $type->is_composite ) {
+ if ( $type_str eq 'void*' ) {
+ # Assume that void* is a reference SV -- either a hashref or an
+ # arrayref.
+ return "$xs_var = newRV_inc( (SV*)($bp_var) );";
+ }
+ }
+
+ confess("Missing typemap for '$type_str'");
+}
+
+sub write_xs_typemap {
+ my ( undef, %args ) = @_;
+ my $hierarchy = $args{hierarchy};
+
+ my $typemap_start = _typemap_start();
+ my $typemap_input = _typemap_input_start();
+ my $typemap_output = _typemap_output_start();
+
+ for my $class ( $hierarchy->ordered_classes ) {
+ my $full_struct_sym = $class->full_struct_sym;
+ my $vtable = $class->full_vtable_var;
+ my $label = $vtable . "_";
+ $typemap_start .= "$full_struct_sym*\t$label\n";
+ $typemap_input .= <<END_INPUT;
+$label
+ \$var = ($full_struct_sym*)XSBind_sv_to_lucy_obj(\$arg, $vtable, NULL);
+
+END_INPUT
+
+ $typemap_output .= <<END_OUTPUT;
+$label
+ \$arg = (SV*)Lucy_Obj_To_Host(\$var);
+ LUCY_DECREF(\$var);
+
+END_OUTPUT
+ }
+
+ # Blast it out.
+ sysopen( my $typemap_fh, 'typemap', O_CREAT | O_WRONLY | O_EXCL )
+ or die "Couldn't open 'typemap' for writing: $!";
+ print $typemap_fh "$typemap_start $typemap_input $typemap_output"
+ or die "Print to 'typemap' failed: $!";
+}
+
+sub _typemap_start {
+ my $content = <<END_STUFF;
+# Auto-generated file.
+
+TYPEMAP
+chy_bool_t\tCHY_BOOL
+chy_i8_t\tCHY_SIGNED_INT
+chy_i16_t\tCHY_SIGNED_INT
+chy_i32_t\tCHY_SIGNED_INT
+chy_i64_t\tCHY_BIG_SIGNED_INT
+chy_u8_t\tCHY_UNSIGNED_INT
+chy_u16_t\tCHY_UNSIGNED_INT
+chy_u32_t\tCHY_UNSIGNED_INT
+chy_u64_t\tCHY_BIG_UNSIGNED_INT
+
+lucy_ZombieCharBuf\tZOMBIECHARBUF_NOT_POINTER
+END_STUFF
+
+ return $content;
+}
+
+sub _typemap_input_start {
+ my ( $big_signed_convert, $big_unsigned_convert );
+ if ( $Config{ivsize} == 8 ) {
+ $big_signed_convert = '$var = ($type)SvIV($arg);';
+ $big_unsigned_convert = '$var = ($type)SvUV($arg);';
+ }
+ else {
+ $big_signed_convert = '$var = ($type)SvNV($arg);';
+ $big_unsigned_convert = '$var = ($type)SvNV($arg);';
+ }
+ return <<END_STUFF;
+
+INPUT
+
+CHY_BOOL
+ \$var = (\$type)SvTRUE(\$arg);
+
+CHY_SIGNED_INT
+ \$var = (\$type)SvIV(\$arg);
+
+CHY_UNSIGNED_INT
+ \$var = (\$type)SvUV(\$arg);
+
+CHY_BIG_SIGNED_INT
+ $big_signed_convert
+
+CHY_BIG_UNSIGNED_INT
+ $big_unsigned_convert
+
+ZOMBIECHARBUF_NOT_POINTER
+ \$var = lucy_ZCB_make_str(SvPVutf8_nolen(\$arg), SvCUR(\$arg));
+
+END_STUFF
+}
+
+sub _typemap_output_start {
+ my ( $big_signed_convert, $big_unsigned_convert );
+ if ( $Config{ivsize} == 8 ) {
+ $big_signed_convert = 'sv_setiv((IV)$arg);';
+ $big_unsigned_convert = 'sv_setuv((UV)$arg);';
+ }
+ else {
+ $big_signed_convert = 'sv_setnv((NV)$arg);';
+ $big_unsigned_convert = 'sv_setnv((NV)$arg);';
+ }
+ return <<END_STUFF;
+
+OUTPUT
+
+CHY_BOOL
+ sv_setiv(\$arg, (IV)\$var);
+
+CHY_SIGNED_INT
+ sv_setiv(\$arg, (IV)\$var);
+
+CHY_UNSIGNED_INT
+ sv_setuv(\$arg, (UV)\$var);
+
+CHY_BIG_SIGNED_INT
+ $big_signed_convert
+
+CHY_BIG_UNSIGNED_INT
+ $big_unsigned_convert
+
+END_STUFF
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Binding::Perl::TypeMap - Convert between BP and Perl via XS.
+
+=head1 DESCRIPTION
+
+TypeMap serves up C code fragments for translating between Perl data
+structures and Boilerplater data structures. The functions to_perl() and
+from_perl() achieve this for individual types; write_xs_typemap() exports all
+types using the XS "typemap" format documented in C<perlxs>.
+
+=head1 FUNCTIONS
+
+=head2 from_perl
+
+ my $c_code = from_perl( $type, $bp_var, $xs_var, $stack_var );
+
+Return C code which converts from a Perl scalar to a variable of type $type.
+
+Variable declarations must precede the returned code, as from_perl() won't
+make any declarations itself.
+
+=over
+
+=item * B<type> - A Boilerplater::Type, which will be used to select the
+mapping code.
+
+=item * B<bp_var> - The name of the variable being assigned to.
+
+=item * B<xs_var> - The C name of the Perl scalar from which we are extracting
+a value.
+
+=item * B<stack_var> - Only required needed when C<type> is
+Boilerplater::Object indicating that C<bp_var> is an either an Obj or a
+CharBuf. When passing strings or other simple types to Boilerplater functions
+from Perl, we allow the user to supply simple scalars rather than forcing them
+to create Boilerplater objects. We do this by creating a ZombieCharBuf on the
+stack and assigning the string from the Perl scalar to it. C<stack_var> is
+the name of that ZombieCharBuf wrapper.
+
+=back
+
+=head2 to_perl
+
+ my $c_code = to_perl( $type, $xs_var, $bp_var );
+
+Return C code which converts from a variable of type $type to a Perl scalar.
+
+Variable declarations must precede the returned code, as to_perl() won't make
+any declarations itself.
+
+=over
+
+=item * B<type> - A Boilerplater::Type, which will be used to select the
+mapping code.
+
+=item * B<xs_var> - The C name of the Perl scalar being assigned to.
+
+=item * B<bp_var> - The name of the variable from which we are extracting a
+value.
+
+=back
+
+=head1 CLASS METHODS
+
+=head2 write_xs_typemap
+
+ Boilerplater::Binding::Perl::Typemap->write_xs_typemap(
+ hierarchy => $hierarchy,
+ );
+
+=over
+
+=item * B<hierarchy> - A L<Boilerplater::Hierarchy>.
+
+=back
+
+Auto-generate a "typemap" file that adheres to the conventions documented in
+L<perlxs>.
+
+We generate this file on the fly rather than maintain a static copy because we
+want an entry for each Boilerplater type so that we can differentiate between
+them when checking arguments. Keeping the entries up-to-date manually as
+classes come and go would be a pain.
+
+=head1 COPYRIGHT AND LICENSE
+
+ /**
+ * Copyright 2009 The Apache Software Foundation
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ * implied. See the License for the specific language governing
+ * permissions and limitations under the License.
+ */
+
+=cut
+
Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Binding/Perl/TypeMap.pm
------------------------------------------------------------------------------
svn:eol-style = native