#!/usr/local/bin/perl
#			Copyright (c) 1992 by IRCAM
#			    All rights reserved.
#
#  For any information regarding this and other IRCAM software, please 
#  send email to:
#                              manager@ircam.fr

#
# mkskel	2.8 IRCAM 8/24/92
#
# Create a skeleton file for a program in C, perl or sh.
#
# Modification history
#
# 28-Jul-92 - Michel Fingerhut (fingerhu@ircam.fr)
#

#------------------------------------------------------------------------------
# site-dependent configurable part (optional)
#------------------------------------------------------------------------------

$ORG	  = "IRCAM";			# no blanks
$MAILHOST = "ircam.fr";			# fully qualified name (where author is)
$MANAGER  = "manager@ircam.fr";		# full address whom to send questions to
$IDSTRING = "%I\045 $ORG \045G%";	# for SCCS, e.g.. (\045=%...)
$LOGSTRING= "Modification history";	# for RCS, might be $Log$, e.g.
$LIBSKEL  = "/usr/local/lib/mkskel";	# where the skeletons are
$NAME	  = "NAME";			# default if not specified
$MKDEPEND = "cc -Em";			# or "gcc -M"; if none, default code

#------------------------------------------------------------------------------
# end of configuration
#------------------------------------------------------------------------------

$[ = 1;                 	# set array base to 1
$, = ' ';               	# set output field separator
$\ = "\n";              	# set output record separator

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$dst) = localtime(time);
%month= ( 1, 'Jan', 2, 'Feb', 3, 'Mar', 4, 'Apr', 5, 'May', 6, 'Jun',
	   7, 'Jul', 8, 'Aug', 9, 'Sep', 10, 'Oct', 11, 'Nov', 12, 'Dec');
chop($hostname= `hostname`);
$options = "s:l:t:rv";
$usage   = "Usage: $0 [-v] [-r] [-l dir] [-t type] [-s source] [file]\n";
require 'getopts.pl';

# check arguments and exit (before all the rest) if wrong

&Getopts($options) || die $usage  ;     # parse the arguments

if ($opt_v) {
    print "2.8 IRCAM 8/24/92";
    exit;
}

if ($opt_r) {
    ($IDSTRING, $LOGSTRING, $RCS) =('$Revision$ '."$ORG".' $Date$', '$Log$', 1);
} else {
    $SCCS= 1;
}

#------------------------------------------------------------------------------
# File types: 		pattern:INTERPRETER:COB:COM:COE
#------------------------------------------------------------------------------
%types   = ("c", 	".+\.c::/*: *: */",
            "cc",	".+\.cc:://://://",
	    "csh", 	".+\.csh:/bin/csh:\043:\043:\043",
	    "h", 	".+\.h::/*: *: */",
	    "lisp",	".+\.l::;:;:;",
	    "man", 	".+.\[1-8]::.\\\":.\\\":.\\\"",
	    "perl", 	".+\.pl|perl:/usr/local/bin/perl:#:#:#",
	    "sh", 	".+\.sh:/bin/sh:#:#:#",
	    "make",	"[Mm]akefile:/usr/local/bin/make:#:#:#",
	    "README",	"[Rr][Ee][Aa][Dd][Mm][Ee]::::"
	   );

#------------------------------------------------------------------------------
# File types for Makefiles: pattern for name, name of variable
#------------------------------------------------------------------------------

%subtypes= (".*\\.h",			"INCLUDES",
	    ".*\\.c",			"CFILES",
	    ".*\\.(cc|c\\+\\+)",	"CCFILES",
	    ".*\\.f",			"FFILES",
	    ".*\\.s",			"ASFILES",
	    ".*\\.y",			"YACCFILES",
	    ".*\\.a",			"LIBFILES",
	    ".*\\.l",			"LEXFILES",
	    ".*\\.(sh|csh|pl)",		"SHFILES",
	    ".*\\.1",			"MANFILES1",
	    ".*\\.2",			"MANFILES2",
	    ".*\\.3",			"MANFILES3",
	    ".*\\.4",			"MANFILES4",
	    ".*\\.5",			"MANFILES5",
	    ".*\\.6",			"MANFILES6",
	    ".*\\.7",			"MANFILES7",
	    ".*\\.8",			"MANFILES8",
	    ".*\\.(mm|me|doc|tex)",  	"DOCFILES",
	    "README|INSTALL",  		"DOCFILES",
	    );

%subtype  =("lib", 1, "sh", 1, "a.out", 1, "perl", 1, "csh", 1);

#-----------------------------------------------------------------------------
# Check arguments
#------------------------------------------------------------------------------

$LIBDIR= $opt_l || $LIBSKEL || "./lib";	# where the skeletons are

die "Unknown file type\n" if defined $opt_t && ! defined $types{$opt_t};

if ($#ARGV) {
    $file= $ARGV[1];
    ($suffix= $file) =~ s/.*\.//;
}

#-----------------------------------------------------------------------------
# Variables likely to be substituted
#------------------------------------------------------------------------------

$MAILHOST = (gethostbyname($hostname))[1] 	unless defined $MAILHOST;
$MANAGER  = "root@$MAILHOST" 			unless defined $MANAGER;
$ORG      = "\U$1\E" if !defined $ORG && $MAILHOST =~ /\.([^\.]+)\.[^\.]*/;
$IDSTRING = "%I\045 $ORG \045G%" 		unless defined $IDSTRING;
$LOGSTRING= $IDSTRING				unless defined $LOGSTRING;
$DATE     = sprintf("%2d-%s-%d", $mday, $month{$mon+1}, $year);
$LOGIN	  = getlogin || (getpwuid($<))[1];
$AUTHOR   = sprintf ("%s (%s@%s)", (getpwuid($<))[7], $LOGIN, $MAILHOST);
$USER	  = $ENV{'USER'};
$HOME	  = $ENV{'HOME'};
$GROUP    = (getgrgid((getpwuid($<))[4]))[1];
$YEAR	  = "19$year";				# soon to modify...
$FILENAME = $file				if defined $file; # else stdout
$NAME     = (split(/\./, "\U$file\E"))[1]	if defined $file; # else default
$Name     = "\U$1\E\L$2\E" 			if $NAME=~ /(.)(.*)/;
$name     = "\L$NAME\E";
#-----------------------------------------------------------------------------
# Determine type and execute
#------------------------------------------------------------------------------

if (defined $opt_t) {
    $type= $opt_t;
} else {
    foreach $t (keys %types) {
	$pattern= (split(/:/, $types{$t}))[1];
	$type= $t, last if defined $file && $file =~ /^$pattern$/;
    }
}
die "Can't tell which type!\n" if ! defined $type;
($pattern, $INTERPRETER, $COB, $COM, $COE)= split(/:/, $types{$type});
$SECTION= $suffix =~ /^[1-8]$/ ? $suffix : 1	if $type eq "man";

# special treatment for Makefiles

if ($type eq "make") {

    # Target name comes right next, no default

    $MAKEFILE= $ARGV[1] || "Makefile" ;
    $TARGET  = $ARGV[2] || "a.out";

    # Type of processing (a.out, sh, lib, perl, csh)

    if (defined $opt_s) {
	die "Unknown source type\n" if ! defined $subtype{$opt_s};
	$subtype = $opt_s;
    } elsif ($TARGET =~ /.a$/) {
        $subtype = "lib";
    } else {
	$subtype = "a.out";
    }
    $subtype=~ s/\./_/g;
    eval "\$\U$subtype\E= 1";

    # Define all variables according to the rest of the files

    foreach $file (@ARGV[3..$#ARGV]) {
	foreach $s (keys %subtypes) {
	    eval "\$$subtypes{$s} .= \"$file \"", last if $file =~ /^$s$/;
	}
    }
}

# now open the output and perform

&openfile($file) 		if defined $file;
&dofile("$LIBDIR/skel.$type");

#------------------------------------------------------------------------------
# Open output file with backup
#------------------------------------------------------------------------------

sub openfile {{
    local($file)= $_[1];
    if (-e $file) {
	die "Files $file and $file.bak exist, not overwritten\n"
	    if -e "$file.bak";
	print STDERR "renaming existing $file to $file.bak";
	rename($file, "$file.bak");
    }
    open (STDOUT, ">$file") || die "Can't open $file for output: $!\n";
    print STDERR "output file is $file";
}}

#------------------------------------------------------------------------------
# Read a file with substitutions and possible inclusions (recurse then)
#------------------------------------------------------------------------------

sub dofile {{
    local($file)= $_[1];
    local($d)= 0;
    open (FILE, $file) || die "Can't find $file: $!\n";

    push(cond, 1) if ! $#cond;			# initialize the stack
    while (<FILE>) {
	chop;

	# perform action if keyword and not nested in a skipped conditional

	$d++, $cond[$#cond]   && push(cond, $d, &docondition($1)),
					next	if /^@@IF (.*)$/;

	$d++, $cond[$#cond]   && push(cond, $d, ! &docondition($1)),
					next	if /^@@IFN (.*)$/;

	$d == $cond[$#cond-1] && push(cond, ! pop(cond)),
					next	if /^@@ELSE$/;

	$d == $cond[$#cond-1] && (pop(cond), pop(cond)), $d--,
					next	if /^@@FI$/;

					next	if ! $cond[$#cond];

	&doinclude($1), 		next	if /^@@INCLUDE (.*)$/;

	(print STDERR $1),		next	if /^@@MESSAGE (.*)$/;

	# if not keyword, substitute variable and print (conditionals first)

	while (/\$\${([^\?}]*)\?([^}]*)/) {	# find all conditionals
	    $cond= $1;
	    $value= $2;
	    &docondition($cond)? s/\$\${[^}]*}/$value/ : s/\$\${[^}]*}//;
	}

	while (/.*\$\$(\w+).*/) {		# find all variables occurrences
	    $value= eval "\$$1";		# compute the value
	    s/\$\$$1/$value/;			# and do the replacement
	}

	s/\\\$\\\$/\$\$/g;			# restore all escaped $$

        &printlongline($_);
    }
    close (FILE);
}}

#------------------------------------------------------------------------------
# doinclude - execute the INCLUDE directive
#------------------------------------------------------------------------------

sub doinclude {{
    local($file)= $_[1];

    $n++;                                            	# for recursion
    open("SAVE$n", "<&FILE") || die "dup: $!\n";	# save handle on "stack"
    $where=tell(FILE);                              	# and place
    &dofile("$LIBDIR/$file");                       	# recurse on dofile
    open(FILE, "<&SAVE$n") || die "dup: $!\n";  	# restore handle
    seek(FILE, $where, 0);                          	# and place
}}


#------------------------------------------------------------------------------
# docondition - evaluate a condition
#------------------------------------------------------------------------------

sub docondition {{
    local($condition)= "$".$_[1];

    $condition=~ s/\./_/g;
    $condition=~ s/\|/\|\|\$/g;
    $condition=~ s/\&/\&\&\$/g;

    "" ne eval $condition;
}}

#------------------------------------------------------------------------------
# printlongline - fold lines with continuation characters
#------------------------------------------------------------------------------

sub printlongline {{
    local($line)= $_[1];
    local($max)= 80;	# for 1st line - 80, then less ('cause of tab)

    while (length($line) > $max) {

	# split at last white space before $max-2
	($l1, $l2)= ($1, $2) 	if substr($line, 1, $max-2) =~/(.*)\s([^\s]*)/;

	# print segment and repeat
	printf "$l1 \\\n\t";
	$line= $l2.substr($line, $max-1);
	$max= 72;
    }

    # print last stuff
    print $line;
}}
