The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/bin/sh
#  -*-Perl-*-
#======================================================================#
# 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 (Wolfgang.Dobler@kis.uni-freiburg.de)
# Date:   06-Feb-2005
# 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> [..]] > <file.pro>
# Options:
#   -h
#   --help                Show usage overview
#   -f <func>
#   --function=<func>     Name the IDL function <func> (default is `param')
#   -d
#   --double              Mark floating-point values as double precision
#   -m
#   --minimize            Minimize strings by trimming trailing whitespace
#   -1
#   --one-line            Instead of a function file, write a single line
#                         representing the structure. Useful if you use
#                         EXECUTE to assign the resulting structure to an IDL
#                         variable
#   -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;
use Fortran::F90Namelist;

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
               -d   --double
               -m   --minimize
               -1   --one-line
               -M=i --maxtags=i
               -q   --quiet
               -v   --version ));

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 $double   = ($opts{'d'} || $opts{'double'}   || 0);
my $oneline  = ($opts{'1'} || $opts{'one-line'} || 0);
my $minimize = ($opts{'m'} || $opts{'minimize'} || 0);
my $maxtags  = ($opts{'M'} || $opts{'maxtags'}  || 0);
$oneline=1 if ($maxtags);
my $quiet = ($opts{'q'} || $opts{'quiet'} || '');

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

@ARGV = ('-') unless(@ARGV);

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

unless ($oneline) {
    print <<"HERE";
;
;  param.pro
;
; Set parameters from Pencil code namelist files (typically param.nml and
; param2.nml).
;
; This file is generated by nl2idl, so you will probably not want to edit
; it.

function $function
; Returns an anonymous structure with all slots set from the namelist
; data in @ARGV.

  COMPILE_OPT HIDDEN

HERE
}

print $nl->output(format   => 'idl',
		  name     => 'par',
		  trim     => $minimize,
		  oneline  => $oneline,
		  maxslots => $maxtags,
		  double   => $double);

unless ($oneline) {
    print "\n  return, par\n\nend\n";
} else {
    print "\n";
}


# ---------------------------------------------------------------------- #
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.2 $';
    my $date = '$Date: 2005/11/21 20:01:15 $';
    $rev =~ s/${doll}Revision:\s*(\S+).*/$1/;
    $date =~ s/${doll}Date:\s*(\S+).*/$1/;
    "$cmdname version $rev ($date)\n";
}
# ---------------------------------------------------------------------- #

# End of file nl2idl