#!/bin/sh
#  -*-Perl-*-  (for Emacs)    vim:set filetype=perl:  (for vim)
#======================================================================#
# Run the right perl version:
if [ -x /usr/local/bin/perl ]; then
  perl=/usr/local/bin/perl
elif [ -x /usr/bin/perl ]; then
  perl=/usr/bin/perl
else
  perl=`which perl| sed 's/.*aliased to *//'`
fi

exec $perl -x -S $0 "$@"     # -x: start from the following line
#======================================================================#
#! /Good_Path/perl -w
# line 17

# Name:   nl2idl
# Author: wd (wdobler [at] cpan.org)
# Date:   11-Aug-2007
# Description:
#   Convert F90 namelists into an idl function that returns an anomymous
#   structure containing all the namelist variables.
# Usage:
#   nl2idl [options] <file1.nml> [<file2.nml> [..]] -o <file.pro>
# Options:
#   -h
#   --help                Show usage overview
#   -f <func>
#   --function=<func>     Name the IDL function <func> (default is 'param')
#   -o
#   --output=<file>       Output file, or stdout if not given
#   -d
#   --double              Mark floating-point values as double precision
#   -m
#   --minimize            Minimize strings by trimming trailing whitespace
#   -M <N>
#   --maxtags=<N>         Like '-1', but split result in blocks of up to <N>
#                         tags: { block1} {block 2} ..
#                         This is because IDL cannot handle structure
#                         definitions wtih more than ~ 300--600 tags in one
#                         execute statement
#   --version             Write version number of nl2idl and exit

use strict;
BEGIN {
    # Make sure ${PENCIL_HOME}/lib/perl is in the Perl path
    if (-d "$ENV{PENCIL_HOME}/lib/perl") {
        unshift @INC, "$ENV{PENCIL_HOME}/lib/perl";
    } else {
        if ($0 =~ m!(.*[/\\])!) { unshift @INC, "$1../lib/perl"; }
    }
}

use Pencil::Util;
Pencil::Util::use_pencil_perl_modules('Fortran::F90Namelist') or die;

use Getopt::Long;
# Allow for '-Plp' as equivalent to '-P lp' etc:
Getopt::Long::config("bundling");

my (%opts);                     # Variables written by GetOptions
my $debug=0;                    # Activate with (undocumented) '--debug' option
my $doll='\$';                  # Need this to trick CVS

## Process command line
GetOptions(\%opts,
           qw( -h   --help
                    --debug
               -f=s --function=s
               -o=s --output=s
               -d   --double
               -m   --minimize
               -M=i --maxtags=i
               -q   --quiet
               -v   --version )
          ) or die "Aborting.\n";

if ($opts{'debug'}) { $debug = 1 } else { $debug = 0 }
if ($debug) {
    printopts(\%opts);
    print "\@ARGV = '@ARGV'\n";
}

if ($opts{'h'} || $opts{'help'})    { die usage();   }
if ($opts{'v'} || $opts{'version'}) { die version(); }

my $function = ($opts{'f'} || $opts{'function'} || 'param');
my $out_file = ($opts{'o'} || $opts{'output'}   || '');
my $double   = ($opts{'d'} || $opts{'double'}   || 0);
my $minimize = ($opts{'m'} || $opts{'minimize'} || 0);
my $maxtags  = ($opts{'M'} || $opts{'maxtags'}  || 0);
my $quiet = ($opts{'q'} || $opts{'quiet'} || '');

##
## End of generalities; here comes the real thing
##

if (!@ARGV) { @ARGV = ('-'); }

if ($out_file) {
    if (-e $out_file) {
        my $need_update = 0;
        my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime_out, $ctime, $blksize, $blocks) = stat ($out_file);
        foreach my $file (@ARGV) {
            if (-e $file) {
                my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime_in, $ctime, $blksize, $blocks) = stat ($file);
                if ($mtime_in >= $mtime_out) { $need_update = 1; }
            }
        }
        if (!$need_update) {
            open (OUT_FILE, "< ".$out_file) or die ("Error while reading '".$out_file."' ($!)\n");
            while (!eof (OUT_FILE)) {
                my $code = <OUT_FILE>;
                print $code;
            }
            close (OUT_FILE);
            exit (0);
        }
    }
}

my $out_handle = \*STDOUT;
if ($out_file) {
    open (OUT_FILE, "> ".$out_file) or die ("Error while opening '".$out_file."' ($!)\n");
    $out_handle = \*OUT_FILE;
}

my $nl  = Fortran::F90Namelist->new();
my $nl2 = Fortran::F90Namelist->new();
$nl2->debug(1) if ($debug);
foreach my $file (@ARGV) {
    $nl2->parse(file => $file, all => 1, merge => 1)
        or die "Couldn't parse file <$file>\n";
    $nl->merge($nl2);
}

my $name = 'par';
if ($out_file =~ /param2\./s) { $name = 'par2'; }
my $code = $nl->output(format => 'idl', name => $name, trim => $minimize,
                       oneline => 0, maxslots => $maxtags, double => $double);

print $out_handle $code;
if ($out_file) {
	close ($out_handle);
	print $code;
}

exit (0);


# ---------------------------------------------------------------------- #
sub printopts {
# Print command line options
    my $optsref = shift;
    my %opts = %$optsref;
    foreach my $opt (keys(%opts)) {
        print STDERR "\$opts{$opt} = '$opts{$opt}'\n";
    }
}
# ---------------------------------------------------------------------- #
sub usage {
# Extract description and usage information from this file's header.
    my $thisfile = __FILE__;
    local $/ = '';              # Read paragraphs
    open(FILE, "<$thisfile") or die "Cannot open $thisfile\n";
    while (<FILE>) {
        # Paragraph _must_ contain 'Description:' or 'Usage:'
        next unless /^\s*\#\s*(Description|Usage):/m;
        # Drop 'Author:', etc. (anything before 'Description:' or 'Usage:')
        s/.*?\n(\s*\#\s*(Description|Usage):\s*\n.*)/$1/s;
        # Don't print comment sign:
        s/^\s*# ?//mg;
        last;                        # ignore body
    }
    $_ or "<No usage information found>\n";
}
# ---------------------------------------------------------------------- #
sub version {
# Return CVS data and version info.
    my $doll='\$';              # Need this to trick CVS
    my $cmdname = (split('/', $0))[-1];
    my $rev = '$Revision: 1.34 $';
    my $date = '$Date: 2007-08-22 16:00:13 $';
    $rev =~ s/${doll}Revision:\s*(\S+).*/$1/;
    $date =~ s/${doll}Date:\s*(\S+).*/$1/;
    "$cmdname version $rev ($date)\n";
}
# ---------------------------------------------------------------------- #

# End of file nl2idl