#!/usr/bin/perl -w

=head1 NAME

 worldStatus - show state of a cvs working dir.

=head1 SYNOPSIS

 worldStatus [-egncrv]
 worldstatus -h

=head1 DESCRIPTION

Pretty-print a summary of a CVS working directory tree.

This documentation is not finished.

=cut

use strict;
use warnings;
use English;
use Term::ANSIColor;
use Getopt::Long;

# -- internal config---------

# We wait for an interval every N calls to cvs status.  We also back off
# linearly from a failed cvs status.  This is because we occasionally notice
# cvs status fails.
# FIXME (Zak) Might this be due to the (now fixed) inetd rate limiting
# problem?  Even if it's not fixed by now, do we need both backoff
# and rate-limiting at the same time?
my $INITIAL_BACKOFF_DURATION = 10; # seconds
my $BACKOFF_DURATION_INCREMENT = 10; # seconds
my $MAX_STATUS_BACKOFFS = 10;

my $status_calls_so_far = 0;
my $NUM_STATUS_CALLS_BETWEEN_RATE_LIMIT_SLEEPS = 50;
my $RATE_LIMIT_SLEEP_DURATION = 5; # seconds

# -- end config -------------

=head1 OPTIONS

You can put options in $HOME/.worldStatus like "$group_by_status = 1;".

=over 4

=item B<-e|with-stderr>

Copy cvs update's stderr to stdout along with the world status.

=item B<-h|help>

display the man page.

=item B<-g|group-by-status>

Group files by their statuses, rather than just outputting them in the
order CVS gives them to us.  This requires collecting all results before
displaying the summary, so will appear to be slower, so is off by default
to stop foolish people whining.

=item B<-m|machine-readable>
=item B<-n|no-escapes> (deprecated)

Try to make the output as machine-readable as possible, e.g. don't use any
escape sequences at all.  Does not suppress stderr, and does not make sense to
combine with --verbose or --with-stderr.

=item B<-c|only-in-cvs>

Don't show files that have status "NOT IN CVS".

=item B<-r|use-local-root>

Use whatever CVSROOT value is found in CVS/Root, rather than propagating
your $CVSROOT environment variable setting to the CVS commands we run.
This can cause worldStatus to silently fail if the user named in CVS/Root
isn't you and he requires a password.  This option might be useful if you
run worldStatus on a world checked out from a repository different to that
in your $CVSROOT.

=item B<-v|verbose>

Be verbose.

=back 4

=cut

my ($verbose, $help, $machine_readable, $include_cvs_stderr, $group_by_status, $only_in_cvs, $use_local_root);

# Let clued users override defaults with lines like "$group_by_status = 1;".
# Fails silently and continues if the file isn't there.
if (-r "$ENV{HOME}/.worldStatus") {
  eval `cat $ENV{HOME}/.worldStatus`;
}

Getopt::Long::Configure("bundling");
GetOptions(
  'e|with-stderr' => \$include_cvs_stderr,
  'h|help' => \$help,
  'g|group-by-status' => \$group_by_status,
  'n|no-escapes' => \$machine_readable,
  'm|machine-readable' => \$machine_readable,
  'c|only-in-cvs' => \$only_in_cvs,
  'r|use-local-root' => \$use_local_root,
  'v|verbose'=>\$verbose,
);

if ($help) {
  system("perldoc $0");
  exit 0;
}

if ($verbose) {
  print <<EOM;
               World Status (use -h for help)
Phase 1 - accumulating information from cvs
If there are a lot of changes and you've given the -g option this can take
some time and we can end up waiting on the server a fair bit...

EOM
}

###############################################################################
# You shouldn't need to read or edit below here unless you're hacking #########
###############################################################################

# Get the terminal width (for right justification).
# Would prefer to use Term::Size, but it's not ubiquitous.
my ($stty_says, $stty_lines, $stty_columns);
if (!$machine_readable) {
  eval { 
    $stty_says = `stty size`;
    chomp($stty_says);
    ($stty_lines, $stty_columns) = split(/ /, $stty_says);
  };
  if (!defined($ENV{COLUMNS})) {
    if (defined($stty_columns)) {
      $ENV{COLUMNS} = $stty_columns;
    } else {
      $ENV{COLUMNS} = 80;
    }
  }
  if (!defined($ENV{COLUMNS})) {
    if (defined($stty_lines)) {
      $ENV{LINES} = $stty_lines;
    } else {
      $ENV{LINES} = 24;
    }
  }
}

my @GROUP_ORDER = qw( ? M N C U R A K );

my %status_info = (
  '?' => {  name => 'NOT IN CVS',     colour => 'blue',          files => [] },
  'M' => {  name => 'MODIFIED',       colour => 'green',         files => [] },
  'N' => {  name => 'NEEDS MERGE',    colour => 'bold blue',     files => [] },
  'C' => {  name => 'HAS CONFLICTS',  colour => 'bold red',      files => [] },
  'U' => {  name => 'NEEDS UPDATING', colour => 'bold magenta',  files => [] },
  'R' => {  name => 'REMOVED',        colour => 'bold',          files => [] },
  'A' => {  name => 'ADDED',          colour => 'bold green',    files => [] },
  'K' => {  name => 'NEEDS CHECKOUT', colour => 'bold magenta',  files => [] },
);

# $cvsroot contains an option to force use of $CVSROOT if need be, else
# nothing (to use whatever is in CVS/Root).
my $cvsroot;
if ($use_local_root) {
  $cvsroot = '';
} elsif (defined($ENV{CVSROOT})) {
  $cvsroot = "-d $ENV{CVSROOT}";
} else {
  warn("$0: Can't use \$CVSROOT because it's not set; falling back to CVS/Root (this may fail)\n");
  # Need to give $cvsroot some value.
  $cvsroot = '';
}

# Open the pipe.
open(CVS_FAKE_UPDATE, "cvs -nq $cvsroot update -d 2>&1 |")
  or die("Couldn't run fake CVS update: $!");


# Get and print statuses (or if $group_by_status, just accumulate files
# of each status).

while (defined(my $line = <CVS_FAKE_UPDATE>)) {
  if ($status_calls_so_far > $NUM_STATUS_CALLS_BETWEEN_RATE_LIMIT_SLEEPS) {
    $status_calls_so_far = 0;
    sleep($RATE_LIMIT_SLEEP_DURATION);
  }

  chomp($line);
  my ($status_letter, $filename) = split(/ /, $line, 2);

  if ($line =~ /^M /) {
    my $status = get_status($filename);
    if ($status =~ /Needs Merge/) {
      $status_letter = 'N';
    }
  } elsif ($line =~ /Checkout/) {
    $status_letter = 'K';
  } elsif ($line =~ /^\? / && $only_in_cvs) {
    # Skip NOT IN CVS file
    next;
  } elsif ($line !~ /^[CURA?] /) {
    if ($include_cvs_stderr) {
      print STDERR "$line\n";
    }
    next;
  }
  if ($group_by_status) {
    push(@{$status_info{$status_letter}{files}}, $filename);
  } else {
    prettyprint($status_letter, $filename);
  }
}
close(CVS_FAKE_UPDATE);

# Pretty print accumulated files if we grouped by status.
if ($group_by_status) {
  print "World Status is....\n" if $verbose;
  foreach my $status_letter (@GROUP_ORDER) {
    foreach my $filename (@{$status_info{$status_letter}{files}}) {
      prettyprint($status_letter, $filename);
    }
  }
}

sub get_status {
  my ($filename) = @_;
  my $n_tries = 0;
  my $status;
  my $backoff = $INITIAL_BACKOFF_DURATION;
  my $stropped_filename = $filename;
  local ($/); # slurp mode for "cvs status" pipe

  print "examine :  $filename\n" if $verbose;

  $stropped_filename =~ s/\ /\\ /g;
  while (1) {
    open(CVS_STATUS, "cvs $cvsroot status $stropped_filename 2>&1 |")
      or die("Couldn't run cvs status on $stropped_filename: $OS_ERROR");
    $status = <CVS_STATUS>;
    close(CVS_STATUS);
    $n_tries++;
    if ($status =~ /\[status aborted\]/) {
      if ($n_tries > $MAX_STATUS_BACKOFFS) {
	die "Failed to get cvs status to work\n";
      }
      # back off a little (more) and retry.
      $status =~ s/\s+$//ig;
      print "waiting on server....\n" if (!$machine_readable);
      print "warning (non-fatal) : \"$status\" : will retry in ($backoff) " if ($verbose);
      sleep($backoff);
      $backoff += $BACKOFF_DURATION_INCREMENT;
    } else {
      last;
    }
  }
  return $status;
}

# prettyprint($status_letter, $filename)
#
# $status_letter, is a letter from %status_info.  $filename you can guess.
# If $want_escapes is true, no ANSI escape sequences (colour, cursor motion)
# are used.
#
sub prettyprint {
  my ($status_letter, $filename) = @_;
  my $filler; # Space between filename and status description.

  if ($machine_readable) {
    print "${filename},$status_letter,$status_info{$status_letter}{name}";
  } else {
    $filler = $ENV{COLUMNS} - (length($status_info{$status_letter}{name}) - 1);
    # ANSI escape sequence "ESC[nG" moves the cursor to absolute posn n.
    $filler = "\033[${filler}G";
    print color $status_info{$status_letter}{colour};
    print "${filename}${filler}$status_info{$status_letter}{name}";
    print color 'reset';
  }
  print "\n";
}

=head1 Differences from bash version

Differences between this and the previous sh version:
  - this one is huge, and definitely overkill :)
  - uses bold green to highlight ADDED, because some terminals can't handle
    bold black == grey (which is an odd view of the world, to be fair).
  - faster than the sh version
  - but being Perl, this probably isn't as portable
  - options to turn off escape sequences, etc...
  - this script groups files by status
  - there is no "NEEDS PATCH" in this version
  - hopefully fixed a reliance on buggy terminal behaviour that caused last
    letter of status to wrap
  - if you run this one in a world that you don't own (i.e. CVS/Root has a
    user other than you in it) it will work

=head1 TODO

Known bugs/deficiencies:
  - could handle cvs' stderr better - cvs -n up -d warns on stderr about
    file/directory creations that won't happen due to the -n, but as we're
    discarding the stderr we can't list such things.

=head1 AUTHOR

Isaac Wilcox, 2003-12-04

Man paging and the cvs status delay interval, ajw apr04.

basically a clone of a sh script by Dave Haikney.

=cut