p4-fstat

#!/usr/bin/env perl
# p4-fstat --- pretty-printer for various p4 file operations
# Author: Noah Friedman <friedman@splode.com>
# Created: 2016-08-18
# Public domain

# $Id: p4-fstat,v 1.9 2018/01/17 22:06:27 friedman Exp $

# Commentary:

# This is easier to read and workspace paths are more useful.

# Code:

use strict;
use warnings qw(all);

use FindBin;
use lib "$FindBin::Bin/../lib/perl";
use lib "$ENV{HOME}/lib/perl";

use Getopt::Long;
use Pod::Usage;
use POSIX        qw(strftime);

use NF::P4cmd    qw(:direct);
use NF::FileUtil qw(:dir);

my %opt = ( localpath => 0,
          );;

my @flags;
my @filter;

# Fields we request from server
# headTime is the time of the changelist
# headModTime is the modification time of the file, which might be older.
# revtime is only set for shelved files; it's the modtime of the file in the shelf.
my @fieldsT = (qw(depotFile clientFile path haveRev shelved fileSize
                  headAction headChange headRev headType headModTime headTime
                      action     change workRev     type     revtime));


my @fieldsP = (qw(headAction headChange headRev)); # fields/row we print
my @fieldsO = (qw(    action    change  workRev)); # or these if file open

# Fields which are right-justified
my @fieldRJ = (undef, 0, 1, 1); # first undef is for clientFile/depotFile

my $p4info;
my $strftime_fmt = "%Y-%m-%d";

sub parse_options
{
  my $help = -1;

  p4_process_cmdline_options ($_[0]);
  local *ARGV = \@{$_[0]}; # modify our local arglist, not real ARGV.

  my $pthrough = sub { push @flags, join ("", '-', @_) };

  my $parser = Getopt::Long::Parser->new;
  $parser->configure (qw(bundling autoabbrev no_ignore_case));
  my $succ = $parser->getoptions
    ( "debug"            => \$NF::P4cmd::DEBUG,
      "h|?|help+"        => \$help,

      "l|local-path+"    => \$opt{localpath},
      "v|verbose+"       => \$opt{verbose},

      'x=s'              => \$opt{cmd_args},

      # Note that we use -e, not -c, for speed and least surprise since -c
      # also matches any *later* change, a behavior which is not consistent
      # with most other commands. If you really want fstat -c, use after --.
      'c|change=i'       => sub { push @flags, "-e", $_[1] },
      'm|max=i'          => sub { push @flags, "-m", $_[1] },
      'F|filter=s@'      => \@filter,

      'O=s@'             => $pthrough,
      'R=s@'             => $pthrough,
      'S=s@'             => $pthrough,

      "H|have"           => \$opt{have},
      "o|opened"         => \$opt{opened},
      "e|exists"         => sub { push @filter,
                                    (qw(^headAction=delete
                                        ^headAction=move/delete
                                        ^headAction=purge
                                        ^headAction=archive
                                      ));
                                },
      "z|size|filesize+" => \$opt{filesize},

      "p=s"              => \$ENV{OVERRIDE_P4PORT},
      "u=s"              => \$ENV{OVERRIDE_P4USER},
    );

  pod2usage (-exitstatus => 1, -verbose => 0)     unless $succ;
  pod2usage (-exitstatus => 0, -verbose => $help) if $help >= 0;

  if ($opt{opened})
    {
      # This won't catch files open for add w/out -e changeno, which means
      # they've already been shelved.  But without it, this command can be
      # very slow.  So if --have is also specified, use it.
      if ($opt{have}) { push @flags, "-Ro" }
      else            { push @filter, "action=*"; }
    }
  elsif ($opt{have}) { push @flags, "-Rh"; }

  if ($opt{filesize})
    {
      push @flags, "-Ol";
      push @fieldsP, 'fileSize';
      push @fieldsO, 'fileSize';
      $fieldRJ[4] = 1;
    }

  if ($opt{verbose})
    {
      $strftime_fmt = "%Y-%m-%d  %H:%M:%S %z" if $opt{verbose} > 1;
      my $mtime = $opt{verbose} > 2 ? 'headModTime' : 'headTime';

      push @fieldsP, 'headType', $mtime;
      push @fieldsO, 'type',     $mtime;
    }
}

sub p4cmd
{
  my @data = p4 (@_);
  return unless @data;
  die $data[0]->{data} if $data[0]->{code} eq 'error' && @data == 1 ;
  return @data;
}

sub p4info
{
  unless (defined $p4info)
    {
      my @data = p4cmd (qw(info));
      $p4info = $data[0];
    }
  return $p4info;
}

# Modifies arg in-place
sub prune_local
{
  return if substr ($_[0], 0, 2) eq '//';

  my $level   = $opt{localpath};
  my $cwd     = p4info()->{clientCwd};
  my $cwdlen  = length ($cwd);
  my $len     = length $_[0];

  if ($level >= 2 && $len > $cwdlen)
    {
      if (substr ($_[0], 0, $cwdlen) eq $cwd)
        {
          substr ($_[0], 0, $cwdlen+1) = "";
        }
      else
        {
          $_[0] = make_relative_directory_path ($_[0], $cwd);
        }
    }
  return;
}

sub fmtsize
{
  return '' unless defined $_[0] && $_[0] ne '0';

  my $size   = shift;
  my $fmtsize = 1024;
  my @suffix = ('', qw(K M G T P E));
  my $idx = 0;

  while ($size > $fmtsize)
    {
      $size /= $fmtsize;
      $idx++;
    }

  my $fmtstr = $size < 100 && $idx != 0 ? "%.1f%s" : "%d%s" ;
  return sprintf ($fmtstr, $size, $suffix[$idx]);
}

sub main
{
  parse_options (\@_);

  unless (@_)
    {
      push @_, sprintf ("//%s/...", p4info()->{clientName});
      push @flags, "-Rh" unless @flags || @filter;
    }

  push @flags, "-F", join (" & ", @filter) if @filter;
  push @flags, "-T", join (",",   @fieldsT);

  my @cmd = ('fstat');
  unshift @cmd, ('-x', $opt{cmd_args}) if defined $opt{cmd_args};

  my @data = p4cmd (@cmd, @flags, @_);
  my $xFile = $opt{localpath} ? 'clientFile' : 'depotFile';
  my @w;
  my @toprint;
  for my $r (@data)
    {
      # Skip entries that only contain 'desc' when using '-e changelist'
      next unless exists $r->{depotFile};

      if (exists $r->{action})
           { substr ($r->{change},     0, 0, '*') }
      else { substr ($r->{headChange}, 0, 0, ' ') }

      map { substr ($r->{$_}, 0, 0, '#') if exists $r->{$_};
          } (qw(headRev workRev));

      if ($opt{filesize} && exists $r->{fileSize})
        { $r->{fileSize} = fmtsize ($r->{fileSize}) if $opt{filesize} < 2 }
      else
        { $r->{fileSize} = "" }  # common for deleted files

      map { $r->{$_} = strftime ($strftime_fmt, localtime ($r->{$_}))
              if exists $r->{$_};
          } (qw(headModTime headTime revtime));

      # We might not have clientFile if we have no current client or path
      # is not mapped.
      my @row = exists $r->{$xFile} ? $r->{$xFile} : $r->{depotFile};
      prune_local ($row[0]) if $opt{localpath};

      if (exists $r->{action}) { map { push @row, ($r->{$_} || "") } @fieldsO }
      else                     { push @row, @{$r}{@fieldsP} }

      for (my $i = 0; $i < @row; $i++)
        {
          my $len = length ($row[$i]);
          $w[$i] = $len if !defined $w[$i] || $len > $w[$i];
        }

      push @toprint, \@row;
    }

  my @rj = @fieldRJ;
  my $fmt = join ("  ", map { join ("",
                                    (shift @rj ? "%" : "%-"),
                                    $_, "s")
                            } @w) . "\n";
  map { printf $fmt, @$_ } @toprint;
}

main (@ARGV);

# eof