# This file belongs to TLPM v2.19, TeX Live Package Manager
# Public Domain, P.Jackowski@gust.org.pl

# cmdline parsing

# Since I can't rely on windows shell behaviour, I make all the parsing 
# on my own. Some day I'd like to use native shell for u*x, though.

sub resolve_env # resolve environment variables
{
	my $str = \$_[0];
	while($$str =~ s/$reg_envvar/$ENV{$1}/){}
}

*OUT;
*LOG;
$tlpm_output = undef;

$reg_redir  = qr/(>>?|\|)\s*(.+?)\s*\z/;

sub set_out
{
      my $str = \$_[0];
	if($$str =~ s/$reg_redir//)
	{
            $tlpm_output = $2;
            if($1 eq '|')
            {
                  $tlpm_redir = 2;
            }
            else
            {
                  $tlpm_redir = 1;
                  &norm_path($tlpm_output);
                  # $tlpm_output = &rel2abs($tlpm_output,$curr_dir);
            }
            $tlpm_output = $1 . $tlpm_output;
      }
      else
      {
            $tlpm_redir = 0;
      }
}

sub open_out
{
      if(defined $tlpm_output)
	{
	     if(open(OUT,$tlpm_output))
           {
                 select OUT;
           }
	     else
           {
                 &close_out;
                 return $error{'wrong_out'} -> ($tlpm_output);
           }
      }
}

sub close_out
{
	close OUT;
      $tlpm_output = undef;
      select STDOUT;
}

sub open_log
{
	my $log = $tl_target . $tlpm_log;
      if(open(LOG,">>$log"))
      {
            printf LOG ($row_fmt . "%s\n" , $message_prefix . $tlpm_prompt . $cmd_line , "[" . &date . "]");
            &talk2log();
            return(0);
      }
      else
      {
            &undef_target();
            return $error{'wrong_out'} -> ($log);
      }
}

sub close_log
{
	printf LOG ($row_fmt . "%s\n" , $message_prefix . "done" , "[" . &date . "]");
      close LOG;
      &not2log();
}


$reg_white = qr/\A\s+|\A=/;
$reg_dquot = qr/\A\"(.*?)\"/;
$reg_squot = qr/\A\'(.*?)\'/;
$reg_param = qr/\A([^-]\S*)/;
$reg_sopts = qr/\A[-](\w+)/;
$reg_dopts = qr/\A[-]{2}(\w+)/;

sub parse_cmd
{
	my $str = shift;
	my (@opt,@opts);
	while($str ne '')
	{
	        $str =~ s/$reg_white// and next
	     or $str =~ s/$reg_squot// and push(@opt,"$1")
	     or $str =~ s/$reg_dquot// and push(@opt,"$1")
	     or $str =~ s/$reg_param// and push(@opt,"$1")
	     or $str =~ s/$reg_dopts// and push(@opt,"$opt_prefix$1")
	     or $str =~ s/$reg_sopts// and @opt = (@opt,map {"$opt_prefix$_"} split('',$1))
           or $error{'wrong_syn'} -> ($str) and return();
      }
      while(defined($str = shift @opt))
      {
            push(@opts,$str);
            if($str =~ /$reg_option/ && $opt[0] =~ /$reg_option/)
            {
                  push(@opts,'');
            }
      }
      return @opts;
}

sub is_opt
{
	my $arg = shift;
	my $reg;
	foreach(@_)
	{
            $reg = qr/$_\z/;
            return $true if $arg =~ /$reg_option$reg/;
      }
      return $false;
}

sub no_opt
{
	return ($_[0] =~ /$reg_option/ ? $false : $true);
}

sub rem_opt
{
      map {s/$reg_option//} @_;
}

$opt_prefix = 'opt:';
$reg_option  = qr/\A$opt_prefix/o;

1;