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) {
        print <<EOA;

$type
accessor_$method($args)
	$types
  CODE:
    RETVAL = $getter;
  OUTPUT:
    RETVAL
EOA

    }
    elsif ($setter) {
        print <<EOA;
void
accessor_$method($args, value)
    $types
    $type value;
  CODE:
    $setter;
EOA

    }
    else {
        die "both setter and getter are null"
    }

    print <<EOA;
  CLEANUP:
    _check_error(aTHX_ (struct fann_error *)self);

EOA
}


while(<DATA>) {
	chomp;
	next if /^\s*(?:#.*)?$/;
	my (@args) = split /\s*,\s*/;
	@args > 2 or die "wrong number of arguments: $_";

	accessor(@args);
}

__DATA__

training_algorithm, enum fann_train_enum, fann_get_training_algorithm, fann_set_training_algorithm
train_error_function, enum fann_errorfunc_enum, fann_get_train_error_function, fann_set_train_error_function
train_stop_function, enum fann_stopfunc_enum, fann_get_train_stop_function, fann_set_train_stop_function
learning_rate, double, fann_get_learning_rate, fann_set_learning_rate
learning_momentum, double, fann_get_learning_momentum, fann_set_learning_momentum