profile.pl #2

#! /usr/bin/perl -w
use strict;

=head1 Notices

Originally developed for Perforce by VIZIM (www.vizim.com)

Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.

Please see LICENSE.txt in top-level folder of this distribution for
license information

=cut

use File::Spec::Functions qw(catfile);

use Digest::MD5;

use v5.14.0;   # Earliest version testing was performed against

my $APPNAME = "profile.pl";
my $APPWHAT = 'Directory structure profiler; version 1.15';
my $APPNOTICES = "Copyright (c) 2014 Perforce Software, Inc. and VIZIM Worldwide, Inc.
All rights reserved.
See LICENSE.txt for license information.";

=head1 Directory structure profiler

Profile the contents of a directory structure.
The profile indicates directories and files.
Files contain BOM and the content MD5 signature information.

=cut

=head2 Tool focus

The focus of this tool is file existence and content.
Ownership, access rights, time, date, and other metadata is
not output.
Metadata is dependent on the workspace
population characteristics of the tool in use rather than being
a direct result of an import process.

=cut

=head2 Tool output

Files within a directory are listed first.
Subdirectories are then listed recursively.

File and directory names are listed in alphabetical order to make
comparison of results more deterministic.
File details are prefixed with 'F ' while directory details are
prefixed with 'P '.
The prefix values make it easier for comparison tools to resynchronize
at directories.

The primary use of this tool is to compare directory structures.
Typically these directory structures are workspaces created during
import processing.
Comparison is provided by profileCompare.pl.

To help normalize structure comparison the top level directory is
specified by two arguments.
The first argument is a top level directory path that is not listed in
generated output.
The second argument is a directory path that is listed in generated
output.
Either or both of the arguments may be relative paths.

=cut

=head2 Directory separators

Argument path specification is independent of the OS on which this tool
operates.
The tool adjusts directory separators so that they are
consistent and OS appropriate.

=cut

=head2 Case sensitivity

The -u option causes all file and directory names to be converted to upper
case.
This creates a uniformly sorted output that is useful when only content
and existence is important.

This option is only useful on Windows systems.

=cut

=head2 Examples

For example, to compare two workspaces with a common top level workspace
directory name such as (C:\usr\fred\ws) and (C:/usr/joe/ws) you could use:

  profile.pl C:\usr\fred ws >fred
  profile.pl C:/usr/joe ws > joe
  profileCompare.pl fred joe

To compare the workspaces with different top level workspace directory names
such as (C:/usr/fred/ws) and (C:/usr/joe/workspace) you could use:

  profile.pl C:/usr/fred/ws . >fred
  profile.pl C:/usr/joe/workspace . >joe
  profileCompare.pl fred joe

Note the use of '.' as the second argument to remove all parts of the
workspace path from the output.

=cut

sub isDirectoryEmpty($);
sub isDirectoryEmpty($)
{
  my $path = $_[0];

  return 0 if ! -e $path;
  return 0 if ! -d $path;
  my $hDir;
  return 0 if !opendir($hDir, $path);
  my $isEmpty = 1;
  while ($_ = readdir($hDir)) {
    next if m!^\.{1,2}$!;
    my $thisPath = "$path/$_";
    next if -d $thisPath && isDirectoryEmpty( $thisPath );
    $isEmpty = 0;
    last;
  }
  closedir($hDir);
  return $isEmpty;
}

sub FileDetails($)
{
  my $path = $_[0];

  return 'Does Not Exist' unless -e $path;
  if( -d $path ) {
    return 'Directory (no files)' if isDirectoryEmpty( $path );
    return 'Directory';
  }
  return 'Directory' if -d $path;
  return 'Not A File' unless -f $path;

  my $hLocal;
  if( ! open( $hLocal, '<:bytes', $path ) ) {
    return "Can Not Open - $!";
  }

  my $type = '';  
  my $header = '';
  read $hLocal, $header, 3, 0;
  if( $header =~ m!^\xEF\xBB\xBF! ) {
    $type = 'UTF8';
  } elsif( $header =~ m!^\xFE\xFF! ) {
    $type = 'UTF16BE';
  } elsif( $header =~ m!^\xFF\xFE! ) {
    $type = 'UTF16LE';
  } else {
    $type = -z $path ? 'EMPTY' : 'NOBOM';
  }
  seek $hLocal, 0, 0;

  my $ctx = Digest::MD5->new;
  
  $ctx->reset();
  $ctx->addfile( $hLocal );
  close( $hLocal );

  return ($type, uc $ctx->hexdigest() );
}

my $ifUpperNames = 0;

if( defined $ARGV[0] && ($ARGV[0] =~ m!\-+V!) ) {
  print "$APPWHAT\n";
  exit(0);
}

if( defined $ARGV[0] && ($ARGV[0] =~ m!\-+u!) ) {
  $ifUpperNames = 1;
  shift @ARGV;
}

if( (defined $ARGV[0] && ($ARGV[0] =~ m!\-+[h\?]!i)) || (scalar @ARGV != 2) ) {
  print "$APPWHAT
$APPNOTICES

Usage:

$APPNAME -V
$APPNAME [-h|-?]
$APPNAME [-u] CommonRoot TopDirectory\n";
  exit(0);
}

my @list = ();

sub buildList($$);
sub buildList($$)
{
  my ($root, $dir) = @_;

  my $rootPath = catfile( $ARGV[0], $root, $dir );
  die "$rootPath does not exist" if ! -e $rootPath;
  die "$rootPath is not a directory" if ! -d $rootPath;
  
  my $hDIR;
  opendir( $hDIR, $rootPath ) || die "Can't open $rootPath $!";

  my @files = ();
  my @dirs = ();
  while(readdir($hDIR)) {
    next if $_ eq '.' || $_ eq '..' || uc $_ eq '$TF';
    my $local = $ifUpperNames ? uc $_ : $_;
    my $full = catfile( $rootPath, $_ );
    push @files, catfile( $root, $dir, $local ) if -f $full;
    push @dirs, $local if -d $full;
  }
  closedir( $hDIR );
  foreach( sort @files ) {
    push @list, $_;
  }
  foreach( sort @dirs ) {
    push @list, catfile( $root, $dir, $_ );
    buildList( catfile( $root, $dir ), $_ );
  }
}

buildList( '', $ARGV[1] );

foreach(@list) {
  my $full = catfile( $ARGV[0], $_ );
  if( -f $full ) {
    print "F $_   ", FileDetails($full), "\n";
  } elsif( -d $full ) {
    print "P $_   ", FileDetails($full), "\n";
  } else {
    print "? $_   ", FileDetails($full), "\n";
  }
}