#!/usr/bin/perl
# PkgInstOrder

# Given a list of package names, rewrites them in proper installation order.
# Invoke with single argument, the name of the file to be sorted & rewritten.

# 2005-09-13 dvc Created.
# 2006-01-26 dvc Now handles pkginfo output, with choice of output format. Now
#                giving opportunity to avoid having input file overwritten.
# 2006-01-31 dvc No longer overwriting input file. Now handles more formats.
# 2006-04-17 dvc Now accepting input from STDIN.

$ORDER = '/jumpstart/sol10/pkg/200601/Solaris_10/Product/.order';
$USAGE = <<EOS;
Usage:   $0 [-r] [file] # File is pkginfo output or just pkg name list
                        # '-r' for reverse install order (uninstall).
                        # With no <file> arg, accepts input from STDIN.
         $0 -h          # Returns this usage advice.
Action:  File contents printed out with packages in [un]install order.
Example: $0 pkgadd_smi.list
EOS

if ($ARGV[0] =~ m|^-[?h]|i)
{
  &_Err($USAGE,Fmt=>0,Label=>0);
}
else
{
  if ('-r' eq $ARGV[0])
  {
    $ReverseSort = 1;
    shift @ARGV;
  }
  if (0 == @ARGV)
  {
    $UseSTDIN = 1;
  }
  elsif (not -r $ARGV[0])
  {
    &_Err(sprintf(qq|Unable to read from "$ARGV[0]"%s|,$! ? ": $!" : ''));
  }
  if (not -r $ORDER)
  {
    &_Err(sprintf(qq|Unable to read from "$ORDER"%s|,  $! ? ": $!" : ''));
  }
  if (not @ErrMss)
  {
    open  ORDER;
    for (<ORDER>) { chomp; $Order{$_} = ++$i }
    close ORDER;
    if ($UseSTDIN)
    {
      @Lines = <STDIN>;
    }
    else
    {
      open  IN,"< $ARGV[0]";
      @Lines = <IN>;
      close IN;
    }
    chomp @Lines;
    for (@Lines)
    {
      if (/^(#|$)/)
      {
        push @{$FoundBody ? Post : Pre},$_;
      }
      elsif (@Post)
      {
        die qq|Unable to parse "$ARGV[0]" (err=1)|;
      }
      else
      {
        push @Body,$_;
        $FoundBody = 1;
      }
    }
    @Fields = split /\s+/,$Body[0];
    for $i (0 .. $#Fields)
    {
      if (defined $Order{$Fields[$i]})
      {
        $SortField = $i;
        last;
      }
    }
    die qq|Unable to parse "$ARGV[0]" (err=2)| unless defined $SortField;
    %Body = map { (split)[$SortField],$_ } @Body;
    if (1 == @Fields
    or &_IsAgreeable(
     'Print just the sorted package names (vs. entire sorted lines) (y/n)? '))
    {
      @Body = sort { $Order{$a} <=> $Order{$b} } keys %Body;
    }
    else
    {
      @Body = map  { $Body{$_} }
              sort { $Order{$a} <=> $Order{$b} } keys %Body;
    }
    @Body = reverse @Body if $ReverseSort;
    print map "$_\n",@Pre,@Body,@Post;
  }
}

sub _Err
# REV 20050527
# REF $HOST
# REF $SCRIPT
# REF $TTY_COLS
{
  my(@Args) = @_;
  my($Attr,%ErrAttrDefaults,$FH,$IndentLen,$Label,$Line,@Lines,$MaxLen,$Ms,
     @New,$Pos,%Record,$SegLen,$Sub,$Trace,$WrapIndex,$i,$j,$k);

  # --------------------------------- notes ----------------------------------

  # This routine is an attempt to shift the complexity of error messaging from
  # the point of error to a single, versatile error messager. Normally this
  # routine would be called with a single argument consisting of just the
  # basic error message, and lacking terminating punctuation and newline.
  # Default action is to prepend an informational label (error origin info),
  # perform some minimal formatting and punctuation, print it to STDERR, and
  # save it in the global @ErrMss array, the size of which can be tested at
  # the beginning and end of a routine to determine whether errors were
  # encountered. Default behavior can be modified either globally (in
  # %ErrAttrs), or in individual calls, by passing additional arguments. For
  # example, a script running under cron might wish to have error messages
  # written to an error log rather than to STDERR. Setting $ErrAttrs{'FH'} =
  # "\*ERRORLOG" would accomplish this, globally, while invoking this routine
  # with (e.g.) &_Err('Unable to determine host name',FH => "\*ERRORLOG")
  # would accomplish the same for that particular call. In this case 'FH' is a
  # key word used by this routine but, for versatility, arbitrary "key=>value"
  # pairs can be passed. Ordinarily these %ErrAttrs values are used just for
  # processing the error message, with only the error message itself being
  # saved, but for any message for which $ErrAttr{'Hash'} is true, then all
  # %ErrAttrs values (plus any values supplied as arguments to this routine)
  # are preserved as a hashed entry in @ErrMss, of which the actual error ms
  # is the value assigned to the 'Ms' key. This allows arbitrary attributes to
  # be associated with any error message, and could be used (for example) to
  # associate severity levels with an error, for later examination and
  # handling. In the usual case (no stored hash entries), printing the error
  # messages stored in @ErrMss (or whatever name is chosen) is simply "print
  # @ErrMss". For the general case, where there may be a mix of simple array
  # entries (just the error mss) and hashed array entries, use something like
  # "print map { $_->{'Hash'} ? $_->{'Ms'} : $_ } @ErrMss" to see all err mss.

  # ------------------------- load %ErrAttrDefaults --------------------------

  %ErrAttrDefaults = (
    Fmt    => 1,          # boolean: format err ms (punctuate, enable wrap)?
    Gather => 0,          # boolean: special mode; sets FH, Hash, and Push.*
    Hash   => 0,          # boolean: is @ErrMss element a hash (vs. scalar)?
    Indent => '  ',       #  string: indentation for multi-line messages.
    Label  => 1,          # boolean: prepend informative label to error ms?
    Push   => ErrMss,     #  string: push err ms here. '' means no store.
    Wrap => $TTY_COLS||78,# integer: max line len (printing chars) for err ms.
    FH     => '*STDERR',  #  string: 0 or more whitespace-delimited file
                     );   #          handles to print to. '' means no print.
                          # * Gather is used by those subroutines opting to
                          #   collect errors for later processing. These
                          #   errors are (1) simple mss (not hash entries),
                          #   (2) are not printed (may happen later), and
                          #   (3) are pushed in @Errs (not @ErrMss), an array
                          #   local to those subroutines which use Gather.

  # ---------------------------- adjust %ErrAttrs ----------------------------

  if ($ErrAttrs{'Gather'}) # Comments in ErrAttrDefaults init section (above).
  {
    $ErrAttrs{'FH'}   = '';
    $ErrAttrs{'Hash'} = 0;
    $ErrAttrs{'Push'} = 'Errs';
  }

  # ------------------------------ load %Record ------------------------------

  if ('' ne join('',@Args))
  {
    unshift @Args,'Ms' unless grep /^Ms$/,@_; # Usual case: err ms sole arg.
    $Record = { @Args };                      # Make anonymous hash of args.
    for $Attr (keys %ErrAttrDefaults)         # Load error record.
    {
      if (not defined $Record->{$Attr})
      {
        $Record->{$Attr} = defined $ErrAttrs{$Attr} ? $ErrAttrs{$Attr}
                                                    : $ErrAttrDefaults{$Attr};
      }
    }
    if (not $Record->{'Hash'})           # If not specified as a hash, but a
    {                                    # key not present in %ErrAttrDefaults
      for (grep !/^Ms$/,keys %{$Record}) # is found, then assume hash intended
      {
        if (not defined $ErrAttrDefaults{$_})
        {
          $Record->{'Hash'} = 1;
          last;
        }
      }
    }

  # ---------------------- labeling section (optional) -----------------------

  # Scheme:
  #  1 == $Record->{'Label'}: Prepend label.
  #  0 == $Record->{'Label'}: No labeling.
  # -1 == $Record->{'Label'}: Remove label.

    if (1 == $Record->{'Label'}) # Prepend diagnostic label.
    {
      $i++ while caller $i; # Get number of stack frames to examine.
      for ($j = --$i; $j >= 0; $j--) # Go through them, oldest first.
      {
        $Sub = $j == $i ? (caller $j)[0] : ${\((caller $j+1)[3] =~ /::(.*)/)};
        $Trace .= "$Sub\[${\((caller $j)[2])}]";
        $Trace .= '->' if $j;
      }
      $Label  = "$HOST:"    unless '' eq $HOST;
      $Label .=  $SCRIPT || $0;
      $Label .= ": $Trace: ";
    }
    elsif (-1 == $Record->{'Label'}) # Strip any previously applied label.
    {
      $Record->{'Ms'} = join ' ',$Record->{'Ms'};
      $Record->{'Ms'} =~ s|\n||g;
      $Record->{'Ms'} =~ s|  | |g;
      1 while $Record->{'Ms'} =~ s|.*]: (.*)|$1|;
    }

  # --------------------- formatting section (optional) ----------------------

  # Scheme:
  # 0 == $Record->{'Fmt'}: Only label is formatted.
  # 1 == $Record->{'Fmt'}: Label and message are formatted.
  # 2 == $Record->{'Fmt'}: Reformat.
  # Formatting actions:
  #   - All lines have leading/trailing whitespace removed.
  #   - All tabs converted to single spaces.
  #   - First line - if only line - is terminated with single period, unless
  #     already terminated with '!', ':', '?', or '...'.
  #   - All lines, if longer than $Record->{'Wrap'}, are broken at maximum
  #     rindex of following strings:
  #       ']:' - first line only, and only if labeled
  #       '->' - first line only, and only if labeled
  #       ' '  - all lines
  #       ','  - all lines
  #     If none of the above strings are found, then line broken with '\'.
  #   - All lines (except first line) have $Record->{'Indent'} prepended.
  #   - All lines (including first line) terminated with single newline.

    # Line initialization section:

    $Ms = $Record->{'Ms'};
    if (2 == $Record->{'Fmt'})
    {
      $Ms =~ s|\n| |g;
      $Ms =~ s|\s+| |g;
      $Ms =~ s|\s*$||;
    }
    if ($Record->{'Fmt'})
    {
      $Ms =~ s|\t| |g;
      substr($Ms,0,0) = $Label; # Prepend label to ms.
      @Lines = $Ms =~ m|\s*([^\n]*\S+)|g;
    }
    elsif ($Label =~ m|\S|)
    {
      @Lines = ($Label);
    }
    if (scalar @Lines)
    {

    # Line termination section (if passed just a single line):

      if (1 == @Lines)
      {
        $Lines[0] =~ s|\s+$||;
        $Lines[0] =~ s|\.*$|| unless $Lines[0] =~ m|[^.]\.\.\.$|;
        $Lines[0] .= '.' unless $Lines[0] =~ m|[!.:?]$| or '' eq $Lines[0];
      }

    # Line wrap and indentation section (all lines):

      $IndentLen = length $Record->{'Indent'};
      $MaxLen = $Record->{'Wrap'};
      if ($MaxLen > $IndentLen + 10) # Sanity check.
      {
        for $i (0 .. $#Lines)
        {
          $Line = $Lines[$i];
          if (length $Line <= $MaxLen - $IndentLen*(@New>0))
          {
            push @New,"$Line\n";
          }
          else
          {
            while (length $Line > $MaxLen - $IndentLen*(@New>0))
            {
              $WrapIndex = $MaxLen - $IndentLen*(@New>0) - 1;
              $Pos = $j = -1;
              if (0 == $i and $Record->{'Label'})
              {
                $Pos = $j     if ($j=rindex($Line,' ',$WrapIndex+1))  > $Pos;
                $Pos = $j     if ($j=rindex($Line,',',$WrapIndex))    > $Pos;
                $Pos = $j + 1 if ($j=rindex($Line,']:',$WrapIndex-1)) > $Pos;
                $Pos = $j + 1 if ($j=rindex($Line,'->',$WrapIndex-1)) > $Pos;
              }
              else
              {
                $Pos = $j if ($j = rindex($Line,' ',$WrapIndex + 1))  > $Pos;
                $Pos = $j if ($j = rindex($Line,',',$WrapIndex))      > $Pos;
              }
              if (-1 < $Pos)
              {
                $_    = substr $Line,0,$Pos + 1;
                $Line = substr $Line,$Pos + 1;
                s|^\s*(.*\S)\s*$|$1|;
                push @New,"$_\n";
              }
              elsif (defined $New[-1]
              and (($k = length $New[-1]) < $MaxLen - 1))
              {
                chomp $New[-1];
                $SegLen = $MaxLen - $k - $IndentLen - 1;
                $New[-1] .= ' ' . substr($Line,0,$SegLen) . "\\\n";
                $Line = substr $Line,$SegLen;
              }
              else
              {
                $_    = substr $Line,0,$WrapIndex;
                $Line = substr $Line,$WrapIndex;
                s|^\s*(.*\S)\s*$|$1|;
                push @New,"$_\\\n";
              }
            }
            push @New,"$Line\n" if $Line =~ m|\S|;
          }
        }
      }
      for $i (1 .. $#New) { substr($New[$i],0,0) = $Record->{'Indent'} }
    }
    $Record->{'Ms'}  = @New ? join('',@New) : join('',@Lines);
    $Record->{'Ms'} .= $Ms unless $Record->{'Fmt'};

  # ----------------------------- print section ------------------------------

    for $FH (split " ",$Record->{'FH'}) { print $FH $Record->{'Ms'} }

  # ------------------------------ save section ------------------------------

    if ($Record->{'Push'}) # If saving to array, save just ms or whole hash?
    {
      push @{$Record->{'Push'}},$Record->{'Hash'} ? $Record : $Record->{'Ms'};
    }
  }

  return $Record->{'Ms'};
}

sub _IsAgreeable
# REV 20050202
# REF $MODE{'Agreeable'}
{
  local($Question,$Default,$FH) = @_;
  my($Agreeable,$SAVEOUT,$SaveAutoFlush);

  $SAVEOUT = select;
  $SaveAutoflush = $|;
  $FH = $_[2] || STDERR;

  select $FH;
  $| = 1;
  $Agreeable = defined $MODE{'Agreeable'} ? $MODE{'Agreeable'} : undef;
  until (defined $Agreeable)
  {
    print $Question;
    ($_ = <STDIN>) =~ s|^\s*(.*\S)?\s*$|$1|;
    if (/^(y|ye|yes)$/i)
    {
      $Agreeable = 1;
    }
    elsif (/^(n|no)$/i)
    {
      $Agreeable = 0;
    }
    elsif (/\S/)
    {
      print $FH qq|Don't understand "$_"; please try again.\n|;
    }
    elsif ($Default =~ m|^y|i)
    {
      $Agreeable = 1;
    }
    elsif ($Default =~ m|^n|i)
    {
      $Agreeable = 0;
    }
  }
  select $SAVEOUT;
  $| = $SaveAutoflush;

  return $Agreeable;
}

__END__