################################################################################
#      writer: Dan Tsafrir (dants AT cs DOT huji DOT ac DOT il)
# description: Parse command line arfs of pbs2awk.pl and set conversion
#              configuration accordingly.
################################################################################
package ParseArgv;
use strict;
use warnings;
use Data::Dumper;



###############################################################################
# THE EXPORTED INTERFACE:
#
# &parse_argv - parse pbs2swf command line options for full description 
#               see header comment of subroutines.
################################################################################
use Exporter;
our @ISA       = qw(Exporter);
our @EXPORT    = qw(&parse_argv);
our $VERSION   = 1.00;


################################################################################
# config
################################################################################


#-------------------------------------------------------------------------------
# where to find time zone information
#-------------------------------------------------------------------------------
my $g_tzdir = "/usr/share/zoneinfo/";


#-------------------------------------------------------------------------------
# options divide into four categories
#-------------------------------------------------------------------------------
my $OPT_DEFAULT   = 1;		# default of SWF fields
my $OPT_SPEC      = 2;		# memory virtual/physical etc.
my $OPT_ANONYMIZE = 3;		# assign certain codes to given (e.g.) queues
my $OPT_HEADER    = 4;		# stuff composing the SWF header.
my $OPT_SUMMARY   = 5;		# configuring the summary report.
my $OPT_OTHER     = 6;		# other stuff...


#-------------------------------------------------------------------------------
# defining all the options. holds entries like the following
# {
#     'name'      => of option,  
#     'type'      => one of the $OPT_* numbers,
#     'mandatory' => 0|1 is the option mandatory?,
#     'default'   => undef or the default value of option not given,
#     'parsefunc' => ref to the parse function applied on option's value,
#     'usage'     => short option usage note
#     'multiple'  => can option appear more than once?
#     'info'      => info to be used by 'parsefunc'
#    };
#-------------------------------------------------------------------------------
my @g_opts;


################################################################################
# implementation
################################################################################

#-------------------------------------------------------------------------------
# fill @g_opts
#-------------------------------------------------------------------------------
sub init_opts()  {

    # 1) $OPT_DEFAULT: defaults for SWF fields
    my @defaults = 
    (
     {'name' => 'wait'      , 'only_started_jobs' => 0},
     {'name' => 'runtime'   , 'only_started_jobs' => 1},
     {'name' => 'proc_used' , 'only_started_jobs' => 1},
     {'name' => 'cpu_used'  , 'only_started_jobs' => 1},
     {'name' => 'mem_used'  , 'only_started_jobs' => 1},
     {'name' => 'proc_req'  , 'only_started_jobs' => 0},
     {'name' => 'cpu_req'   , 'only_started_jobs' => 0},
     {'name' => 'mem_req'   , 'only_started_jobs' => 0},
     {'name' => 'uid'       , 'only_started_jobs' => 0},
     {'name' => 'gid'       , 'only_started_jobs' => 0},
     {'name' => 'executable', 'only_started_jobs' => 0},
     {'name' => 'queue'     , 'only_started_jobs' => 0},
     {'name' => 'partition' , 'only_started_jobs' => 0},
    );
    foreach my $opt (@defaults) {
	my ($usage, $info);
	if( $opt->{only_started_jobs} ) {
	    $usage = '<default_val>,<started>[,overwrite]';
	    $info  = 'started'
	} else {
	    $usage = '<default_val>,<all|started|canceled>[,overwrite]';
	    $info  = 'all|started|canceled'
	}
	push @g_opts, 
	    {
	     'name'      => $opt->{name},  
	     'type'      => $OPT_DEFAULT,
	     'mandatory' => 0,
	     'default'   => undef,
	     'parsefunc' => \&parse_default,
	     'usage'     => $usage,
	     'multiple'  => 0,
	     'info'      => $info,
	    };
    }

    # 2) $OPT_SPEC: specification associated with some of the SWF fields
    #    n=name, d=>default, i=info
    my @spec = 
    (
     {'n'=>'mem_used.type'    ,'d'=>'virtual'    ,'i'=>'virtual|physical'   },
     {'n'=>'mem_req.type'     ,'d'=>'virtual'    ,'i'=>'virtual|physical'   },
     {'n'=>'mem_used.quantity','d'=>'per_job'    ,'i'=>'per_process|per_job'},
     {'n'=>'mem_req.quantity' ,'d'=>'per_job'    ,'i'=>'per_process|per_job'},
     {'n'=>'cpu_used.quantity','d'=>'per_process','i'=>'per_process|per_job'},
    );
    foreach my $opt (@spec) {
	push @g_opts, 
	    {
	     'name'      => $opt->{n},  
	     'type'      => $OPT_SPEC,
	     'mandatory' => 0,
	     'default'   => $opt->{d},
	     'parsefunc' => \&parse_spec,
	     'usage'     => "<$opt->{i}>",
	     'multiple'  => 0,
	     'info'      => $opt->{i},
	    };
    }

    # 3) OPT_ANONYMIZE: if user wants to associate specific (SWF) values with
    #    certain PBS values. fields are [0]=name [1]=usage
    my @anonymize = 
    (
     ['anonymize.uid'       ,'<PBSuser>:<SWFcode>       e.g. "bartsimpson:13"'],
     ['anonymize.gid'       ,'<PBSgroup>:<SWFcode>      e.g. "system:1"'      ],
     ['anonymize.executable','<PBSexecutable>:<SWFcode> e.g. "whether:2"'     ],
     ['anonymize.queue'     ,'<PBSqueue>:<SWFcode>      e.g. "shortjobs:3"'   ],
     ['anonymize.partition' ,'<PBSpartition>:<SWFcode>  e.g. "c1.cnn.com:1"'  ],
    );
    foreach my $opt (@anonymize) {
	push @g_opts, 
	    {
	     'name'      => $opt->[0],  
	     'type'      => $OPT_ANONYMIZE,
	     'mandatory' => 0,
	     'default'   => undef,
	     'parsefunc' => \&parse_anonymize,
	     'usage'     => $opt->[1],
	     'multiple'  => 1,
	     'info'      => undef,
	    };
    }

    # 4) $OPT_HEADER: stuff composing the header
    #    [0]=name, [1]=mandatory, [2]=multiple, [3]=default, [4]=description
    #
    #    >>>> IMPORTANT! <<<<
    #    PrintSWF::get_swf_header heavily depends on the order of the fields
    #    as they appear in the following @header array. don't change. when
    #    necessary, ad at the end.
    my @header =
    (
     # ----- mandatory: introduction ------------
     ['Computer'      , 1, 1, undef,
      '<short machine description> e.g. "P-III Linux cluster"' ],
     ['Installation'  , 1, 1, undef,
      '<location & name of machine> e.g. "SDSC - Blue Horizon"' ],
     ['Information'   , 1, 1, undef,
      '<where find additional info> usually URL, and paper-ref'],
     ['Acknowledge'   , 1, 1, undef,
      '<name/email of supplier of PBS data>' ],
     ['Conversion'    , 1, 1, undef,
      '<name+email of converter | additional conversion info>'],
     # ----- mandatory: time section ------------
     ['TimeZoneString', 1, 0, undef,
      "<of PBS log> file in $g_tzdir e.g. US/Alaska"],
     # ----- mandatory: limitation fields -------
     ['MaxNodes'      , 1, 0, undef,
      '<int> [comment] e.g. "72 (dual CPU)"'],
     ['MaxProcs'      , 1, 0, undef,
      '<int> [comment] e.g. "144"'],
     # ------ optional: limitation fields -------
     ['MaxRuntime'    , 0, 0, undef,
      '<seconds> administrative max allowed runtime'],
     ['MaxMemory'     , 0, 0, undef,
      '<KB> administrative max allowed memory'],
     ['AllowOveruse'  , 0, 0, undef,
      '<bool> can jobs use more resource(s) than requested?'],
     # ----- queues -----------------------------
     ['Queues'        , 0, 1, '-',
      '<verbal information about queues>'],
     # ----- partitions -------------------------
     ['Partitions'    , 0, 1, '-',
      '<verbal information about partitions>'],
     # ----- CAN ADD OTHER STUFF HERE  ----------
     ['Note'          , 0, 1, undef,
      '<any important note>'],
    );
    foreach my $opt (@header) {
	push @g_opts, 
	    {
	     'name'      => $opt->[0],  
	     'type'      => $OPT_HEADER,
	     'mandatory' => $opt->[1],
	     'default'   => $opt->[3],
	     'parsefunc' => \&parse_atom,
	     'usage'     => $opt->[4],
	     'multiple'  => $opt->[2],
	     'info'      => undef,
	    };
    }


    # 5) $OPT_SUMMARY: configuring how the conversion summary report should be
    #    printed. [0]=name, [1]=default_val, [2]=description
    my @summary = 
    (
     ['exmpl_max'      , 2  ,
      '<int> example record# to print per conversion-problem'],
     ['exmpl_max_unfin', 100,
      '<int> example record# of unfinished jobs (lost data)'],
     ['max_popular'    , 5  ,
      '<int> # of most frequent values to print per SWF field'],
     ['max_anonymize'  , 100,
      '<int> max rows# to print in user etc. anonymize tables'],
    );
    foreach my $opt (@summary) {
	push @g_opts, 
	    {
	     'name'      => $opt->[0],  
	     'type'      => $OPT_SUMMARY,
	     'mandatory' => 0,
	     'default'   => $opt->[1],
	     'parsefunc' => \&parse_atom,
	     'usage'     => $opt->[2],
	     'multiple'  => 0,
	     'info'      => '^\d+$',
	    };
    }


    # 6) $OPT_OTHER
    push @g_opts,
	{
	 'name'      => 'output',   
	 'type'      => $OPT_OTHER, 
	 'mandatory' => 1,
	 'default'   => undef,
	 'parsefunc' => \&parse_atom,
	 'usage'     => '<name of result file e.g. "l_sdsc_sp2">',
	 'multiple'  => 0,
	 'info'      => undef,
	};
    push @g_opts,
	{
	 'name'      => 'help',   
	 'type'      => $OPT_OTHER, 
	 'mandatory' => 0,
	 'default'   => undef,
	 'parsefunc' => undef,
	 'usage'     => 'print this help message',
	 'multiple'  => 0,
	 'info'      => undef,
	};
    push @g_opts,
	{
	 'name'      => 'debug',   
	 'type'      => $OPT_OTHER, 
	 'mandatory' => 0,
	 'default'   => 0,
	 'parsefunc' => \&parse_atom,
	 'usage'     => '<0|1> 1 means an added 19-th SWF field holding PBS-ID',
	 'multiple'  => 0,
	 'info'      => '^[01]$',
	};
}


#-------------------------------------------------------------------------------
# parse an $OPT_DEFAULT options.
#-------------------------------------------------------------------------------
sub parse_default($$) {

    my ($opt, $value) = @_;

    my $info = $opt->{info};
    $value =~ m/^(-?\d+),($info)(,overwrite)?$/
	or return (0, "illegal value for option --$opt->{name}=$value");
    
    return ( 1, {
		 'value'     => $1, 
		 'jobs'      => $2,	# all|started|canceled
		 'overwrite' => defined($3) ? 1 : 0,
		} );
}


#-------------------------------------------------------------------------------
# parse an $OPT_SPEC options.
#-------------------------------------------------------------------------------
sub parse_spec($$) {

    my ($opt, $value) = @_;
    
    my $name =  $opt->{name};
    my $info =  $opt->{info};
    $value   =~ m/^$info$/
	or return (0, "illegal value in --$name=$value");
    
    # $name is something like "mem_req.type"
    my ($swf_field, $spec) = split(/\./, $name); 

    return ( 1, {
		 'value'     => $value,
		 'swf_field' => $swf_field,
		 'spec'      => $spec }	);
}


#-------------------------------------------------------------------------------
# parse an $OPT_ANONYMIZE options.
#-------------------------------------------------------------------------------
sub parse_anonymize($$) {

    my ($opt, $value) = @_;
    my $name = $opt->{name};

    $value =~ m/^(.*):(\d+)$/
       or return (0, "illegal value in --$name=$value");
    ($2 >= 1)
       or return (0, "value of --$name=$value must be >= 1");

    my $pbs_value = $1;
    my $swf_value = $2;

    # $name is something like "anonymize.queue"
    my ($swf_field) = ($name =~ m/^anonymize.(.*)$/);

    return ( 1, {
		 'swf_field' => $swf_field,
		 'pbsvalue'  => $pbs_value,
		 'swfvalue'  => $swf_value } );
}


#-------------------------------------------------------------------------------
# parse simple one-atom options.
#-------------------------------------------------------------------------------
sub parse_atom($$) {

    my ($opt, $value) = @_;

    my $info = $opt->{info};
    if( defined($info) ) {
        $value =~ m/$info/
	    or return (0, "illegal value for option --$opt->{name}=$value");
    }

    return ( 1, $value );
}


#-------------------------------------------------------------------------------
# parse the argv leaving only non-options in it (file(s) name(s)).
# fill the given %$config as specified in the documentation of %Config::CONFIG.
# return: $tz_str (timezone string).
#-------------------------------------------------------------------------------
sub parse_argv($$) {

    my $argv   = shift;		# ref to @ARGV
    my $config = shift;		# ref to %Config::CONFIG
    my @noopt  = ();		# non options from @ARGV
    my %name2n = ();		# key = optname, value = occurrences in @$argv
    my %pt     = ();		# from opt's name to it entry in @g_opts
    my %header = ();		# $header{$field} = ref2arr of values


    # 1: firstly, make parse table:
    foreach my $opt (@g_opts) {
	my $name = $opt->{name};
	! exists $pt{$name} or die "bug: two opts with same name '$name'";
	$pt{$name} = $opt;
    }


  PARSE_OPTS:
    # 2: now parse opts
    foreach my $arg (@$argv) {
	
	# help?
	usage(0, "all is well")
	    if( $arg =~ m/^--help/ );

	# handle non-opt
	if( $arg !~ m/^--([^=]+)(=(.+))?$/ ) {
	    push @noopt, $arg;
	    next;
	}

	# it's an opt
	my $name  = $1;
	my $value = $3;
	my $opt   = $pt{$name};

	defined $opt 
	    or usage(1,"undefined option '$name'");
	defined $value
	    or usage(1,"option --$name must be associated with a value");
	
	# handle multiple occurrences of same opt
	if( exists $name2n{$name} ) {
	    ($opt->{multiple}==1) 
		or usage(1,"option '$name' can appear only once");
	    $name2n{$name}++;
	} else {
	    $name2n{$name} = 1;
	}
	
	# parse
	my ($success, $answer) = $opt->{parsefunc}($opt, $value);
	$success or usage(1, $answer);
	my $type = $opt->{type};
	
	# update %config
	if( $type == $OPT_DEFAULT ) {
	    $config->{defaults}{$name} = $answer;
	}
	elsif( $type == $OPT_SPEC ) {
	    my $value     = $answer->{value};     # virtual|per_job|...
	    my $swf_field = $answer->{swf_field};
	    my $spec      = $answer->{spec};      # type|quantity
	    $config->{spec}{$swf_field}{$spec} = $value;
	}
	elsif( $type == $OPT_ANONYMIZE ) {
	    my $swf_field = $answer->{swf_field};
	    my $pbsval    = $answer->{pbsvalue};
	    my $swfval    = $answer->{swfvalue};
	    $config->{anonymize}{$swf_field}{$pbsval} = $swfval;
	}
	elsif( $type == $OPT_HEADER ) {
	    # here order is important so we can't just insert to 
	    # @{$config->{header}}.
	    # we will do this later, when parsing is over.
	    push @{$header{$name}}, $answer;
	}
	elsif( $type == $OPT_SUMMARY ) {
	    $config->{summary}{$name} = $answer;
	}
	elsif( $type == $OPT_OTHER ) {
	    $config->{other}{$name} = $value;
	}
	else {
	    die "bug";
	}
    }

    # 3: give defaults if options were not explicitly given
    @$argv = ();
    foreach my $opt (@g_opts) {
	my $name    = $opt->{name};
	my $default = $opt->{default};
	next if( exists $name2n{$name} || ! defined($default) );
	push @$argv, "--$name=$default";
    }
    goto PARSE_OPTS 
	if scalar(@$argv) > 0;

    # 4: insert header fields to %$config in the correct order
    foreach my $opt (@g_opts) {
	my $name = $opt->{name};
	my $vals = $header{$name};
	if( defined($vals) ) {
	    foreach my $val (@$vals) {
		push @{$config->{header}}, {'name'=>$name, 'value'=>$val};
	    }
	}
    }

    # 5: check that all mandatory fields were given
    foreach my $opt (@g_opts) {
	usage(1, "you must supply the mandatory option '$opt->{name}'")
	    if( $opt->{mandatory} && ! exists $name2n{$opt->{name}} );
    }

    # 6: set argv to hold only non-opts 
    @$argv = @noopt;

    # 7: retrieve the time zone and make sure it does indeed exists
    my ($tz) = grep( $_->{name} =~ m/TimeZoneString/ , @{$config->{header}}) ;
    my $tzfile = "$g_tzdir$tz->{value}";
    usage(1, "failed to fined timezone file '$tzfile'")
	if( ! -r $tzfile );

    return $tz->{value};
}


#-------------------------------------------------------------------------------
# print usage message. assume @g_opts is already initialized.
#-------------------------------------------------------------------------------
sub usage($$) {

    my ($code, $error) = @_;

    if($code != 0 ) {
	# wrong command line opts
	print STDERR 
	    "usage: $0 <options> [PBS files]\n",
	    "problem with command line options: $error\n",
	    "use --help to print a usage message.\n";
    }
    else {
	# --help was given

	my $i    = 0;
	my $sep  = 
	    sprintf("|--|%20s|-|-|%11s|%56s|\n",
		    "-" x 20, "-" x 11, "-" x 56);
	
	print "\n";
	print $sep;
	printf("|# |%20s|M|X|%-11s|%-56s|\n",
	       "long option (use --)", "default", "value");
	print $sep;
	
	my $prev_type = $OPT_DEFAULT;
	foreach my $opt (@g_opts) {
	    if( $opt->{type} != $prev_type ) {
		print $sep;
		$prev_type = $opt->{type};
	    }
	    printf("|%2d|%20s|%1s|%1s|%-11s|%-56s|\n",
		   ++$i,
		   $opt->{name},
		   $opt->{mandatory} ? "*" : "",
		   $opt->{multiple}  ? "*" : "",
		   defined($opt->{default}) ? $opt->{default} : "",
		   $opt->{usage} );
	}
	
	print $sep;
	print "M = mandatory option\n";
	print "X = option can be given more than once\n";
	print "for detailed explanation see:\n\t",
	"http://www.cs.huji.ac.il/labs/parallel/workload/pbs2swf/index.html\n";
    }
	
    exit($code);
}


#-------------------------------------------------------------------------------
# initialize @g_opts
#-------------------------------------------------------------------------------
init_opts();


#-------------------------------------------------------------------------------
# check
#-------------------------------------------------------------------------------
if ( 0 ) {
    my %config = ();
    parse_argv(\@ARGV, \%config);
    print STDERR Dumper(\%config);
    print "\@ARGV = @ARGV\n";
}


#-------------------------------------------------------------------------------
sub DESTROY {
}
1;
################################################################################
#                                   EOF
################################################################################
