view release on metacpan or  search on metacpan

genaccessors  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

$| = 1;

my %struct = ( 'AI::FANN' => 'struct fann *',
               'AI::FANN::TrainData' => 'struct fann_train_data *' );

sub accessor {
    my ($name, $type, $getter, $setter, @ixs) = @_;
	
    my ($package, $method) = $name =~ /^(?:(.*)::)?(.*)$/
        or die "wrong accessor name $name";

    $package = $package ? "AI::FANN::$package" : 'AI::FANN';
    my $struct = $struct{$package}
        or die "wrong package name $package";

    push @ixs, 'value' unless grep /^value$/, @ixs;
    my @ixs1 =  grep !/^value$/, @ixs;

    my $nixs = @ixs;

    my $types = join("\n    ", "$struct self;", map "unsigned int $_;", @ixs1);
    my $args = join(', ', 'self', @ixs1);
    my $setargs = join(', ', 'self', @ixs);

    if ($getter) {
        if ($getter =~ /^->/) {
            $getter = "self->$getter"
        }
        else {
            $getter = "$getter($args)"
        }
    }

    if ($setter) {
        if ($setter =~ /^->/) {
            $setter = "self->$setter = value"
        }
        else {
            $setter = "$setter($setargs)"
        }
    }


    print <<HEAD;

MODULE = AI::FANN    PACKAGE = $package    PREFIX = accessor_
HEAD

    if ($setter and $getter) {
        print <<EOA

$type
accessor_$method($args, value = NO_INIT)
    $types
    $type value
  CODE:
    if (items > $nixs) {
        $setter;
    }
    RETVAL = $getter;
  OUTPUT:
    RETVAL
EOA

    }
    elsif ($getter) {