use Config;
use File::Basename qw(&basename &dirname);
chdir dirname($0);
$file = basename($0, '.PL');
open(OUT, "> $file") || die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";

print OUT <<"!GROK!THIS!";
$Config{startperl}
    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;
!GROK!THIS!

print OUT <<'!NO!SUBS!';
# $Id: perlrpcgen.PL,v 1.4 1997/05/01 22:06:47 jake Exp $

#   Copyright 1997 Jake Donham <jake@organic.com>

#   You may distribute under the terms of either the GNU General
#   Public License or the Artistic License, as specified in the README
#   file.

use perlrpcgen::RPCLParser;
use perlrpcgen::Fstream;

use perlrpcgen::RPCL::cliprocs;
use perlrpcgen::RPCL::fix_typenames;
use perlrpcgen::RPCL::gen_constants;
use perlrpcgen::RPCL::gen_typemap;
use perlrpcgen::RPCL::serprocs;
use perlrpcgen::RPCL::structprocs;
use perlrpcgen::RPCL::types;

use Getopt::Long;



# -----------------------------------------------------------------------------
# main

sub usage {
  print STDERR <<EOF;
Usage: perlrpcgen [--makefile] [--all] [--client] [--server] [--data]
		  [--constants] [--module mod] [--typemap tm] [--fork]
		  [--perl p] [--cc cc] [--rpclibs libs] rpcfile.x
EOF
  exit(1);
}

# -----------------------------------------------------------------------------
# main

# used by typemap code
$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;

# typemaps for T_PTROBJs which also accept undef for the null pointer.
$t_ptrubj_in = <<'EOF';
    if (sv_derived_from($arg, \"${ntype}\")) {
	IV tmp = SvIV((SV*)SvRV($arg));
	$var = ($type) tmp;
    }
    else if ($arg == &sv_undef)
	$var = ($type) 0;
    else
	croak(\"$var is not of type ${ntype}\")
EOF

$t_ptrubj_out = <<'EOF';
    sv_setref_pv($arg, \"${ntype}\", (void*)$var);
EOF

$dirmode = 0755;

@orig_argv = @ARGV;

&GetOptions('module=s' 		=> \$module,
	    'typemap=s@' 	=> \@typemaps,
	    'makefile' 		=> \$makefile,
	    'perl=s'		=> \$perl,
	    'cc=s'		=> \$cc,
	    'rpclibs=s'		=> \$rpclibs,
	    'all'		=> \$all,
	    'client'		=> \$client,
	    'server'		=> \$server,
	    'data'		=> \$data,
	    'constants'		=> \$constants,
	    'fork'		=> \$fork);

&usage unless $ARGV[0];

$intfile = $ARGV[0];
$intfile =~ s/\.x$//; # strip trailing .x

$module = $intfile unless $module;
!NO!SUBS!

print OUT <<"!GROK!THIS!";
\$perl = '$Config{perlpath}' unless \$perl;
\$cc = '$Config{cc}' unless \$cc;
!GROK!THIS!

print OUT <<'!NO!SUBS!';
$rpclibs = '-lrpcsvc -lnsl' unless $rpclibs;

if ($all) {
  $client = 1;
  $server = 1;
  $data = 1;
  $constants = 1;
}

if ($makefile) {
  &do_makefile;
}

else {
  $interface = &read_interface($ARGV[0]);

  # collapse all the typenames and typedefs
  foreach $def (@$interface) {
    $def = $def->fix_typenames;
  }

  # topologically sort the type graph so that typemaps which depend on
  # one another come out right.
  my $marks = {};
  my $order = [];
  foreach $def (@$interface) {
    $def->topo_sort($marks, $order) unless $marks->{$def};
  }

  # generate the typemaps.
  $typein{'T_PTRUBJ'} = $t_ptrubj_in;
  $typeout{'T_PTRUBJ'} = $t_ptrubj_out;
  foreach $def (@$order) {
    $def->gen_typemap($module);
  }

  # generate the constants.
  foreach $def (@$interface) {
    $def->gen_constants;
    @constants = sort @constants;
  }

  mkdir($module, $dirmode);
  &do_typemap;
  &do_typedefs;
  &do_root_makefile;

  if ($data) {
    mkdir("$module/Data", $dirmode);
    &do_data_xs;
    &do_data_perlmod;
    &do_data_makefile;
  }

  if ($constants) {
    mkdir("$module/Constants", $dirmode);
    &do_constants_perlmod;
    &do_constants_xs;
    &do_constants_makefile;
  }

  if ($client) {
    mkdir("$module/Client", $dirmode);
    &do_client_xs;
    &do_client_perlmod;
    &do_client_makefile;
  }

  if ($server) {
    mkdir("$module/server", $dirmode);
    # push(@typemaps, "$module/typemap");
    &read_typemaps(@typemaps);
    &do_server;
    &do_server_makefile;
  }
}



# -----------------------------------------------------------------------------
# Read the interface definition and return a syntax tree

sub read_interface {
  my ($fn) = @_;

  open (INT, $fn) || die $!;

  $s = Fstream->new(\*INT, $fn);
  $p = RPCLParser->new(\&RPCLParser::yylex, \&RPCLParser::yyerror, 0);

  my $interface =  $p->yyparse($s);

  close INT;

  return $interface;
}



# -----------------------------------------------------------------------------
# Write the typemap.

sub do_typemap {
  open (FH, "> $module/typemap") || die $!;

  print FH "# Generated by perlrpcgen.\n";

  print FH "TYPEMAP\n";
  foreach $name (keys %typemap) {
    print FH $name . "\t" . $typemap{$name} . "\n";
  }
  print FH "RPC::ONC::Client\tT_PTROBJ\n";

  print FH "\nINPUT\n";
  foreach $name (keys %typein) {
    print FH $name . "\n" . $typein{$name};
  }

  print FH "\nOUTPUT\n";
  foreach $name (keys %typeout) {
    print FH $name . "\n" . $typeout{$name};
  }

  close FH;
}



# -----------------------------------------------------------------------------
# Write typedefs.h

sub do_typedefs {
  open (FH, "> $module/typedefs.h") || die $!;

  print FH "/* Generated by perlrpcgen. */\n";

  foreach $name (keys %structs) {
    print FH $structs{$name} . ";\n";
  }

  foreach $name (keys %typedef) {
    my $cname = $name;
    $cname =~ s/::/__/;
    print FH "typedef " . $typedef{$name} . "\t" . $cname . ";\n";
  }
  print FH "typedef CLIENT *\tRPC__ONC__Client;\n";

  close FH;
}



# -----------------------------------------------------------------------------
# Write the common data structure code.

sub do_data_xs {
  open (FH, "> $module/Data/Data.xs") || die $!;

  print FH <<EOF;
/* Generated by perlrpcgen. */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "$intfile.h"
#include "typedefs.h"

#include <rpc/rpc.h>

MODULE = ${module}::Data\tPACKAGE = ${module}::Data

PROTOTYPES: DISABLE

EOF

  foreach $def (@$interface) {
    $def->structprocs($module, \*FH);
  }

  close FH;
}



# -----------------------------------------------------------------------------
# Write the client code.

sub do_client_xs {
  open (FH, "> $module/Client/Client.xs") || die $!;

  print FH <<EOF;
/* Generated by perlrpcgen. */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "$intfile.h"
#include "typedefs.h"

#include <rpc/rpc.h>

/* kinda stupid to put this in every client module, but I'm not sure
   how to get to symbols in another shared object library */

void set_perl_error(int errno, char *errstr)
{
  static SV *sv_errno = 0;
  static SV *sv_errstr = 0;

  if (!sv_errno) sv_errno = perl_get_sv("RPC::ONC::errno", TRUE);
  if (!sv_errstr) sv_errstr = perl_get_sv("RPC::ONC::errstr", TRUE);
  sv_setiv(sv_errno, (IV) errno);
  sv_setpv(sv_errstr, errstr);
}

void set_perl_error_clnt(CLIENT *clnt)
{
  struct rpc_err err;
  clnt_geterr(clnt, &err);
  set_perl_error(err.re_status, clnt_sperrno(err.re_status));
}

MODULE = ${module}::Client\tPACKAGE = ${module}::Client

PROTOTYPES: DISABLE

EOF

  foreach $def (@$interface) {
    $def->cliprocs($module, \*FH);
  }

  close FH;
}



# -----------------------------------------------------------------------------
# Write the server code.

sub do_server {
  open (FH, "> $module/server/server.c") || die $!;

  print FH <<EOF;
/* Generated by perlrpcgen. */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "$intfile.h"
#include "typedefs.h"
#include <syslog.h>
#include <rpc/rpc.h>

static PerlInterpreter *my_perl;

extern void xs_init();

void initperl(int argc, char **argv)
{
  int ret;
  my_perl = perl_alloc();
  perl_construct(my_perl);

  if ((ret = perl_parse(my_perl, xs_init, argc, argv, 0)) != 0)
    exit(ret);
  if ((ret = perl_run(my_perl)) != 0)
    exit(ret);
}

SV *callperl(char *func, SV *arg, struct svc_req *rqstp, SVCXPRT *transp,
	     int checkarg)
{
  SV *ret, *req = sv_newmortal(), *tr = sv_newmortal();
  int count;

  dSP;
  ENTER;
  SAVETMPS;
  PUSHMARK(sp);

  sv_setref_pv(req, "RPC::ONC::svc_req", (void *)rqstp);
  sv_setref_pv(tr, "RPC::ONC::Svcxprt", (void *)transp);

  if (arg) {
    XPUSHs(arg);
  }
  XPUSHs(req);
  XPUSHs(tr);
  PUTBACK;

  count = perl_call_pv(func, G_SCALAR|G_EVAL);
  SPAGAIN;

  if (checkarg && count != 1)
    croak("subroutine did not return 1 argument");

  ret = POPs;
  SvREFCNT_inc(ret);

  PUTBACK;
  FREETMPS;
  LEAVE;

  return ret;
}

EOF

  foreach $def (@$interface) {
    $def->serprocs($module, \*FH);
  }

  close FH;
}



# -----------------------------------------------------------------------------
# Write the constants code (borrowed from h2xs).

sub do_constants_xs {
  open (FH, "> $module/Constants/Constants.xs") || die $!;

  print FH <<EOF;
/* Generated by perlrpcgen. */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "$intfile.h"

static int
constant(char *name, int arg)
{
  errno = 0;
  switch (*name) {
EOF

  foreach(@constants){
    @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
    @az = 'a' .. 'z' if !@az && /^[a-z]/;
    @under = '_'  if !@under && /^_/;
  }

  foreach $letter (@AZ, @az, @under) {

    last if $letter eq 'a' && !@constants;

    print FH "    case '$letter':\n";
    my($name);
    while (substr($constants[0],0,1) eq $letter) {
      $name = shift(@constants);
      print FH <<"END";
	if (strEQ(name, "$name"))
	    return $name;
END
    }
    print FH <<"END";
	break;
END
  }
  print FH <<"END";
    }
    errno = EINVAL;
    return 0;
}

MODULE = ${module}::Constants	PACKAGE = ${module}::Constants

PROTOTYPES: DISABLE

int
constant(name,arg)
    char *	name
    int		arg

END

  close FH;
}



# -----------------------------------------------------------------------------
# Write the Perl modules

sub do_data_perlmod {
  open (FH, "> $module/Data/Data.pm") || die $!;

  print FH <<EOF;
# Generated by perlrpcgen.

package ${module}::Data;
use Exporter;
use DynaLoader;
\@ISA = qw(Exporter DynaLoader);
bootstrap ${module}::Data;
1;
EOF

  close FH;
}

sub RPCL::Syntax::progvers { () }

sub RPCL::ProgramDef::progvers {
  my ($self) = @_;
  return ($self->ident, $self->versions->[0]->ident);
}

sub do_client_perlmod {
  open (FH, "> $module/Client/Client.pm") || die $!;

  my ($prog, $vers);
  foreach $def (@$interface) {
    last if ($prog, $vers) = $def->progvers;
  }

  print FH <<EOF;
# Generated by perlrpcgen.

package ${module}::Client;
use Exporter;
use DynaLoader;
use RPC::ONC;
use ${module}::Constants;
\@ISA = qw(Exporter DynaLoader RPC::ONC::Client);
bootstrap ${module}::Client;

sub new {
  my (\$class, \$server, \$prot, \$prog, \$vers) = \@_;
  \$prot = 'netpath' unless \$prot;
  \$prog = $prog unless \$prog;
  \$vers = $vers unless \$vers;
  my \$client =
    &RPC::ONC::Client::clnt_create(\$server, \$prog, \$vers, \$prot);
  bless \$client, \$class;
}

EOF

  print FH <<EOF;
1;
EOF

  close FH;
}

# based on h2xs
sub do_constants_perlmod {
  my ($kind) = @_;

  open (FH, "> $module/Constants/Constants.pm") || die $!;

  print FH <<EOF;
# Generated by perlrpcgen.

package ${module}::Constants;
use Exporter;
use DynaLoader;
use AutoLoader;
\@ISA = qw(Exporter AutoLoader DynaLoader);
\@EXPORT = qw(
    @constants
);
sub AUTOLOAD {
    local(\$constname);
    (\$constname = \$AUTOLOAD) =~ s/.*:://;
    \$val = constant(\$constname, \@_ ? \$_[0] : 0);
    if (\$! != 0) {
	\$AutoLoader::AUTOLOAD = \$AUTOLOAD;
	goto &AutoLoader::AUTOLOAD;
    }
    eval "sub \$AUTOLOAD { \$val }";
    goto &\$AUTOLOAD;
}
bootstrap ${module}::Constants;
1;
__END__
EOF

  close FH;
}



# -----------------------------------------------------------------------------
# Write the Makefile.PLs

sub do_root_makefile {
  open (FH, "> $module/Makefile.PL") || die $!;

  print FH <<EOF;
# Generated by perlrpcgen.

use ExtUtils::MakeMaker;
WriteMakefile(
    'NAME'	=> '${module}',
    'VERSION'	=> '0.1',
    'OPTIMIZE'	=> '-g',
);
EOF
  
  close FH;
}

sub do_data_makefile {
  open (FH, "> $module/Data/Makefile.PL") || die $!;

  print FH <<EOF;
# Generated by perlrpcgen.

use ExtUtils::MakeMaker;
WriteMakefile(
    'NAME'	=> '${module}::Data',
    'VERSION'	=> '0.1',
    'INC'	=> '-I.. -I../..',
    'CC'	=> '$cc',
    'LD'	=> '$cc',
);
EOF

  close FH;
}

sub do_constants_makefile {
  open (FH, "> $module/Constants/Makefile.PL") || die $!;

  print FH <<EOF;
# Generated by perlrpcgen.

use ExtUtils::MakeMaker;
WriteMakefile(
    'NAME'	=> '${module}::Constants',
    'VERSION'	=> '0.1',
    'INC'	=> '-I.. -I../..',
    'CC'	=> '$cc',
    'LD'	=> '$cc',
);
EOF

  close FH;
}

sub do_client_makefile {
  open (FH, "> $module/Client/Makefile.PL") || die $!;

  print FH <<EOF;
# Generated by perlrpcgen.

use ExtUtils::MakeMaker;
WriteMakefile(
    'NAME'	=> '${module}::Client',
    'VERSION'	=> '0.1',
    'LIBS'	=> ['-lrpcsvc -lnsl'], 
    'INC'	=> '-I.. -I../..',
    'CC'	=> '$cc',
    'LD'	=> '$cc',
    'LDFROM'	=> 'Client.o ../../${intfile}_xdr.o ../../${intfile}_clnt.o',
);
EOF

  close FH;
}

sub do_server_makefile {
  open (FH, "> $module/server/Makefile") || die $!;

  print FH <<EOF;
# Generated by perlrpcgen.

CC=$cc
RPCLIBS=$rpclibs
PERL=$perl
MOD=$module
INT=$intfile
CPPFLAGS=-I.. -I../..
CFLAGS=`\$(PERL) -MExtUtils::Embed -e ccopts` -g
LDFLAGS=`\$(PERL) -MExtUtils::Embed -e ldopts`

perlxsi.c:
	\$(PERL) -MExtUtils::Embed -e xsinit --

\$(INT)_svc: ../../\$(INT)_svc.o server.o perlxsi.o
	\$(CC) -o \$(INT)_svc server.o perlxsi.o \\
	../../\$(INT)_xdr.o ../../\$(INT)_svc.o \\
	\$(RPCLIBS) \$(CFLAGS) \$(LDFLAGS)
EOF

  close FH;
}

sub do_makefile {
  open (FH, "> Makefile") || die $!;

  pop @orig_argv; # remove $intfile.x
  @orig_argv = grep { $_ !~ /-ma/ } @orig_argv; # remove -makefile
  my $opts = join(' ', map { "'$_'" } @orig_argv);
  my $serv = ($server ? "\$(MOD)/server/\$(INT)_svc" : '');
  my $forkfix = '';
  if ($fork) {
    $forkfix = "-e 's/result = (/if (!fork()) { _rpcsvccount--; " .
      "_rpcsvcstate = _SERVED; return; }; result = (/' \\\n\t    " .
	"-e 's/^\treturn/\texit(0)/'\\\n\t";
  }

  print FH<<EOF;
# Generated by perlrpcgen.

INT=$intfile
MOD=$module
CC=$cc
PERL=$perl
PERLRPCGEN=$0
RPCLIBS=$rpclibs
CFLAGS=-g

all: .perlmods $serv

.perlrpcgen: \$(INT).x
	\$(PERLRPCGEN) $opts -typemap \\
	`\$(PERL) -MConfig -e 'print "\$\$Config{privlib}/ExtUtils/typemap"'` \\
	\$(INT).x
	touch .perlrpcgen

.Makefiles: .perlrpcgen
	cd \$(MOD); \$(PERL) Makefile.PL
	touch .Makefiles

\$(INT)_xdr.c \$(INT)_clnt.c \$(INT)_svc.c: \$(INT).x
	rpcgen \$(INT).x
	mv \$(INT)_svc.c \$(INT)_svc.c~
	sed -e "s/svc_run();/initperl(argc, argv); svc_run();/" \\
	    -e "s/main()/main(int argc, char **argv)/" \\
	    -e "s/for (i = 0;/\\/*for (i=0;/" \\
	    -e "s/(i, 2);/(i, 2);\\*\\//" \\
	    -e "s/rqstp)/rqstp, transp)/" \\
	    $forkfix< \$(INT)_svc.c~ > \$(INT)_svc.c

.perlmods: .Makefiles \$(INT)_xdr.o \$(INT)_clnt.o
	cd \$(MOD); make
	touch .perlmods

\$(MOD)/server/\$(INT)_svc: .perlrpcgen \$(INT)_svc.o
	cd \$(MOD)/server; make \$(INT)_svc

tidy:
	rm -f *~ "#*" core

clean: tidy
	rm -f .perlrpcgen .Makefiles .perlmods
	rm -f *.h *.c *.o
	rm -rf \$(MOD)

install: all
	cd \$(MOD); make install
EOF

  close FH;
}


# -----------------------------------------------------------------------------
# Code to deal with typemaps (taken from xsubpp). It would be nice to
# have a more general embedpp that would generate embedding stubs from
# typemaps and some kind of embedding language.

sub read_typemaps {
  my (@tm) = @_;
  my ($mode, $junk, $current, $proto);

  foreach $typemap (@tm) {
    next unless -e $typemap ;
    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next 
      unless -T $typemap ;
    open(TYPEMAP, $typemap) 
      or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
    $mode = 'Typemap';
    $junk = "" ;
    $current = \$junk;
    while (<TYPEMAP>) {
      next if /^\s*#/;
        my $line_no = $. + 1; 
      if (/^INPUT\s*$/)   { $mode = 'Input';   $current = \$junk;  next; }
      if (/^OUTPUT\s*$/)  { $mode = 'Output';  $current = \$junk;  next; }
      if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk;  next; }
      if ($mode eq 'Typemap') {
	chomp;
	my $line = $_ ;
	TrimWhitespace($_) ;
	# skip blank lines and comment lines
	next if /^$/ or /^#/ ;
	  my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
	    warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
	$type = TidyType($type) ;
	$type_kind{$type} = $kind ;
	# prototype defaults to '$'
	$proto = "\$" unless $proto ;
	warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n") 
	  unless ValidProtoString($proto) ;
	$proto_letter{$type} = C_string($proto) ;
      }
      elsif (/^\s/) {
	$$current .= $_;
      }
      elsif ($mode eq 'Input') {
	s/\s+$//;
	$input_expr{$_} = '';
	$current = \$input_expr{$_};
      }
      else {
	s/\s+$//;
	$output_expr{$_} = '';
	$current = \$output_expr{$_};
      }
    }
    close(TYPEMAP);
  }

  foreach $key (keys %input_expr) {
    $input_expr{$key} =~ s/\n+$//;
  }
}

sub TrimWhitespace
{
    $_[0] =~ s/^\s+|\s+$//go ;
}

sub TidyType
{
    local ($_) = @_ ;

    # rationalise any '*' by joining them into bunches and removing whitespace
    s#\s*(\*+)\s*#$1#g;
    s#(\*+)# $1 #g ;

    # change multiple whitespace into a single space
    s/\s+/ /g ;
    
    # trim leading & trailing whitespace
    TrimWhitespace($_) ;

    $_ ;
}

sub ValidProtoString ($)
{
    my($string) = @_ ;

    if ( $string =~ /^$proto_re+$/ ) {
        return $string ;
    }

    return 0 ;
}

sub C_string ($)
{
    my($string) = @_ ;

    $string =~ s[\\][\\\\]g ;
    $string ;
}

__END__

=head1 NAME

perlrpcgen - generate Perl interfaces from ONC RPC interface definitions

=head1 SYNOPSIS

B<perlrpcgen> [B<--makefile>] [B<--all>] [B<--client>] [B<--server>]
[B<--data>] [B<--constants>] [B<--module> module] [B<--typemap>
typemap] [B<--fork>] [B<--perl> perl] [B<--cc> cc] [B<--rpclibs>
rpclibs] rpcfile.x

=head1 DESCRIPTION

I<perlrpcgen> builds a set of Perl extensions and a server shell from
an ONC RPC interface definition. For an interface Foo, I<perlrpcgen>
creates modules Foo::Client, Foo::Data, and
Foo::Constants. Foo::Client contains routines for creating a Foo
client and making remote procedure calls via the client. Foo::Data
contains routines for creating and manipulating the data structures
defined in the Foo interface. Foo::Constants contains functions to
retrieve the constants defined in the Foo interface.

=head1 OPTIONS

The option parsing uses Getopt::Long, so you can abbreviate option
names.

=over 4

=item B<--makefile>

Generates a top-level Makefile which will build all the
pieces. Include all the other options you want so they'll be
propagated to the Makefile.

=item B<--all>

Implies --client, --server, --data, and --constants. This is usually
what you want.

=item B<--client>

Generates Foo::Client module.

=item B<--server>

Generates Foo/server/foo_svc.

=item B<--data>

Generates Foo::Data module.

=item B<--constants>

Generates Foo::Constants module.

=item B<--module> module

Sets the basename of the modules. If not given, the name defaults to
the basename of the interface file.

=item B<--typemap> typemap

Uses the given typemap during stub generation. This option can be
specified many times. I<perlrpcgen> generates a typemap for the data
structures in the interface, but you also need the main Perl typemap.

=item B<--fork>

Munges the server shell code so that it forks for each request. You
probably don't want to do this (it's better to prefork several
processes when you start the server and let them fight over accept()
calls).

=item B<--perl> perl

Sets the Perl binary against which extensions should be
built. Defaults to the Perl you used to install I<perlrpcgen>.

=item B<--cc> cc

Sets the C compiler to use. Defaults to the compiler used when
building Perl.

=item B<--rpclibs> rpclibs

Sets the RPC libraries to link against. Defaults to '-lnsl -lrpcsvc'.

=back

=head1 MODULES

=head2 Foo::Client

RPC clients and the procedure calls they support are encapsulated in
Foo::Client objects (which inherit from RPC::ONC::Client).

A new Foo::Client can be created like this:

    $foo = Foo::Client->new($server, $prot, $prog, $vers);

$prot, $prog, and $vers are optional, and will default to 'netpath',
the value of the first 'program' declaration in the interface, and the
value of the first 'version' declaration in the interface,
respectively.

If the client creation fails, the constructor will set
$RPC::ONC::errno and $RPC::ONC::errstr to the error number and error
string, respectively, and croak.

For each procedure there is a method with the same name (with an
underscore and the version number appended as in C). Methods are
called like this:

    $val = $foo->someproc_1($arg);

$arg must be an object of the correct type as given in the interface
definition (see Foo::Data for details), or nothing if the interface
specifies a 'void' argument. If the remote procedure call fails, the
method will set $RPC::ONC::errno and $RPC::ONC::errstr and croak.

You'll need to use RPC::ONC, Foo::Data, Foo::Constants, and
Foo::Client in your client code.

=head2 Foo::Data

For each structure and union definition 'bar' in the interface
definition, I<perlrpcgen> creates a package in the Foo::Data module
called Foo::bar. (If your interface contains an anonymous structure or
union you'll get a package with an arbitrary name--you'll have to
check out the Foo::Data module to see what it is. A warning would be
nice here.)

You can create a new Foo::bar object like this:

    $bar = Foo::bar->new;
    $bar2 = Foo::bar->new($bar);

The first form creates an uninitialized object. The second form
initializes an object by doing a shallow copy of another object.  Be
careful; you can cause coredumps and other weird behavior if you try
to get an uninitialized field from a structure or return a structure
with any uninitialized fields to a client (in that case the XDR
routine for the structure will blow up). Finally, there's nothing
stopping you from setting or retrieving the wrong type from a union
(this may be fixed in a future version), and you can coredump that way
too.

For each field in a structure or union (including the discriminant of
a union) there is a getter (with the same name) that returns the value
of the field, and a setter (with the same name prepended with 'set_')
which takes an argument of the appropriate type and sets the
field. For fields which are structures or unions themselves, the
getter returns a reference to the field, so if you set the fields on
this sub-structure you'll side-effect the super-structure.

In order to avoid having to doink around with various levels of
indirection (as in C), all structures and unions are passed by
reference, and multiple indirections are collapsed into one. So you
can do $foo->set_bar($baz) whether foo is a structure, a pointer to a
structure, a pointer to a pointer to a structure, etc.

As part of this magic, all the typedefs are collapsed as well. So if
your interface has, say, 'typedef bar *quux' and a particular
procedure calls for a 'quux', pass it a Foo::bar from Perl--there is
no Perl type corresponding to 'quux'. (This is perhaps less of a good
thing than the pointer collapsing but I couldn't see a simple way to
do one without the other.)

Finally, functions which call for a pointer to a structure or union
may be passed undef, which translates to a NULL pointer.

Types are converted from their XDR/RPC definitions as follows:

=over 4

=item int, unsigned int, enum

Become Perl numbers.

=item string, opaque

Become Perl strings (and are length-checked if a length is specified).

=item struct, union

Become Perl objects as described above.

=item bar[], bar<>

Become Perl arrays of Foo::bar objects (and are length-checked if a
length is specified).

=back

=head2 Foo::Constants

All the constants (including enums and identifiers for 'program' and
'version' definitions) defined in the interface are available via
Foo::Constants (and are imported by default).

=head2 Server

I<perlrpcgen> creates a server shell which embeds Perl. To implement
the procedure calls, you must define a function in the main package
for each procedure defined in the interface (as in C, they should have
the same names with an underscore and the version number appended).

These functions are called as follows:

    $val = someproc_1($arg, $svc_req, $transp);
    $val = someproc_1($svc_req, $transp);

$arg is the procedure argument (of the appropriate type) or nothing if
the procedure is declared to take 'void'. $svc_req is an
RPC::ONC::svc_req object (see RPC::ONC) through which the client's
credentials can be accessed. $transp is an RPC::ONC::Svcxprt object
(see RPC::ONC) through which the client's IP address can be accessed.

You'll need to use RPC::ONC, Foo::Data, and Foo::Constants, but don't
try to use Foo::Client in a server, because you'll get symbol
conflicts.

The command line arguments are passed unchanged to Perl. Usually you
start a server with something like:

    Foo/server/foo_svc Foo.pl

If you're planning to write a lot of servers you might want to build
Perl with a shared libperl.

=head1 AUTHOR

Jake Donham <jake@organic.com>

=head1 THANKS

Thanks to Organic Online <http://www.organic.com/> for letting me hack
at work.

=head1 SEE ALSO

L<rpcgen(1)>, L<RPC::ONC(3)>

=head1 BUGS

If your interface has comments or other preprocessor statements in it
you need to run it through cpp before giving it to I<perlrpcgen>.

I<perlrpcgen> should use MakeMaker for the top-level Makefile.

=cut
!NO!SUBS!

close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';