view release on metacpan or  search on metacpan

clownfish/lib/Clownfish/Binding/Perl.pm  view on Meta::CPAN

    %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;
#include "XSBind.h"
#include "boil.h"
#include "$self->{boot_h_file}"

#include "KinoSearch/Object/Host.h"
#include "KinoSearch/Util/Memory.h"
#include "KinoSearch/Util/StringHelper.h"

#include "Charmonizer/Test.h"
#include "Charmonizer/Test/AllTests.h"

$generated_xs

MODULE = KinoSearch   PACKAGE = KinoSearch::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 KinoSearch::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 = Clownfish::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> };
        }