#!/usr/bin/perl
#
# perlstub: ok, I've got bored typing all those perl function stubs
#	    this is a code generator (see The Pragmatic Programmer)
#	    that reads a function stub of the form
#		typical call example
#		{
#		comment lines
#		}
#	    for instance:
#		my( $a, $b ) = wibble( x, y, @z );
#		{
#		do some wibbling with $x, $y and @z
#		returning a pair ($a,$b)
#		}
#	    and then writes a complete perl subroutine stub, complete with
#	    standard comment format, prototype and the breaking of the
#	    param array into variables named precisely as in the example
#	    call, with '$' prefixes added if they're missing..
#
#           Given the above example input, the output would be:
#               #
#               # my( $a, $b ) = wibble( x, y, @z );
#               #     do some wibbling with $x, $y and @z
#               #     returning a pair ($a,$b)
#               #
#               sub wibble ($$@)
#               {
#                     my( $x, $y, @z ) = @_;
#                     # STUB: write me
#               }
#
#       (C) Duncan C. White, May 2007
#

use strict;
use warnings;

# should we use new Function::Parameters style, or old 'sub' style?
my $stylevar = $ENV{PERLSTUB_STYLE};
my $newstyle = defined $stylevar && $stylevar eq 'fp' ? 1 : 0;

my $func = <>;		    # read first line
chomp $func;

$func =~ s/\)[^\)]*$/)/;    # lose anything after the close bracket

print "#\n";
print "# $func;\n";

while( <> )                 # consume all the rest of the input.
{
	print "#\t$_" unless /^[{}]$/;
}
print "#\n";

$func =~ s/\s+//g;          # lose all whitespace
$func =~ s/^.*=//;          # lose any 'thing =' prefix..

# handle optional "thing->" prefix (method call form)
my $ismethod   = 0;
$ismethod      = 1 if $func =~ s/^(.+)->//;
my $objorcls   = $1 // "";
my $isclass    = $objorcls =~ /^[A-Z]/ ? 1 : 0;
my $extraparam = $isclass ? '$class' : '$self';

# what's left should look like: wibble(x,y,@z)
$func =~ /^(\w+)\(([^)]*)\)$/;

my $funcname = $1;          # extract the parts
my $params   = $2;
#print "debug: func $func, name $funcname, params $params\n";
#print "debug: ismethod $ismethod, isclass $isclass, extraparam $extraparam\n";

my @params;
my $protostr = "";
foreach (split( /,/, $params ))       # foreach comma separated parameter
{
    s/^/\$/ unless /^[\$@%]/;         # prepend $ unless a sigil present
    push @params, $_;                 # build up an array of parameters
    /^(.)/;                           # extract the parameter's sigil
    $protostr .= $1;                  # add it to the prototype string
}

if( $ismethod && ! $newstyle )
{
    unshift @params, $extraparam;     # prepend extra leading parameter
    $protostr =~ s/^/\$/;             # and one more leading scalar
}

my $paramstr = join( ", ", @params ); # join parameters up again
$paramstr    = '$class: ' . $paramstr if $newstyle && $ismethod && $isclass;
#print "debug: paramstr=$paramstr, protostr=$protostr\n";

my $mydec = '';
$mydec    = "\tmy( $paramstr ) = \@_;\n" if $paramstr && ! $newstyle;
my $firstline = "sub $funcname ($protostr)";
$firstline = "fun $funcname( $paramstr )" if $newstyle && ! $ismethod;
$firstline = "method $funcname( $paramstr )" if $newstyle && $ismethod;

print "$firstline\n";
print "{\n$mydec";
print "\t# STUB: write me...\n";
print "}\n\n\n";
