p4Util.pm #1

#!perl -w
# -*- Perl -*-
# Copyright 1999 Greg Spencer (greg_spencer@acm.org)

package p4Util;

BEGIN {
    # because not all machines do Y2K stuff right...
    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
    @epoch = localtime(0);
}

###############################################################
# Subroutines
###############################################################

# This takes a time integer and creates a simple timestamp from it.
# It returns a time string and a date string in a list (in that order).
# The date and time are in the local time zone.
# I *think* it's Y2K safe, but there is no warranty.
sub ShortTimestamp {
    my $ltime = shift;
    my $ampm = "am";
    my @now = localtime($ltime);
    if ($now[2]>12 && $now[2]!=24) {
        $now[2] -= 12;
        $ampm = "pm";
    }
    elsif ($now[2] == 12) {
	# fix for "noon"
        $ampm = "pm";
    }
    elsif ($now[2] == 24) {
	# fix for "midnight"
        $ampm = "am";
        $now[2] = 12;
    }

    # do that Y2K stuff -- yucko.
    # localtime should just return a four char year...
    $year = $now[5];
    $year += $YearFix if ($now[5] < $epoch[5]);

    # just in case they do it "right" on some machines.
    $year -= 1900 if $year > 1900;
    $year += 1900;

    return (sprintf ("%2d:%02d:%02d$ampm",$now[2],$now[1],$now[0]),
	    sprintf("%d/%d/%04d",$now[4]+1,$now[3],$year));
}

# This collects information about a list of files in the perforce
# database.
#
# It returns a hash of hashes with a number of pieces of information about
# the files.
#
# If the hash doesn't contain a file that was in the input, then that
# file could not be found, and the exists member will be undef.
# The hash is indexed by depot name (not local name).
#
# Stuff you can get:
#      clientFile      -- local path
#      depotFile       -- name in depot (same as hash key)
#      headAction      -- action at head rev, if in depot
#      headChange      -- head rev type, if in depot
#      headRev         -- head rev #, if in depot
#      headType        -- head rev type, if in depot
#      headTime        -- head rev mod time, if in depot
#      haveRev         -- rev had on client, if on client
#      action          -- open action, if opened
#      change          -- open changelist#, if opened
#      unresolved      -- unresolved integration records
#      otherOpen       -- set if someone else has it open
#      otherLock       -- set if someone else has it locked
#      ourLock         -- set if this user/client has it locked
#      exists          -- set if this file exists on the server
#      error           -- set if there was an error accessing the server
sub GetFileInfo {
    my @input_files = @_;
    my %filehash;
    my $line;
    my %info;
    my @dircandidates;

    # quote the filenames (in case there are spaces)
    foreach (@input_files) {
	chomp;
	$_ = "\"$_\"";
    }

    # open the input pipe
    if (!open(INPUT,"p4 fstat @input_files 2>&1 |")) {
	return ();
    }

    foreach $line (<INPUT>) {
	chomp $line;
	
	# These are extra args -- we convert them here to a list
	# attached to the original entry.  We're assuming that all the
	# args have the form of otherOpen, which is that there is a
	# field called "otherOpen" at the top level containing a count
	# of other clients that have this file open, and additional
	# args containing the names of the clients who have it open,
	# with names like "otherOpen0" and "otherOpen1".  We replace
	# the top level value with a list where the top level value
	# (the count, in this case) is the first entry in the list,
	# and we append all other values to the list as we encounter
	# them.
	if ($line =~ m/^\.\.\. \.\.\.\s+(\w+)\s+(.*)/) {
	    my $parentarg = $1;
	    my $arg = $2;
	    $parentarg =~ s/\d+$//; # just strip the numbers to find the parent

	    # list is already there -- just append the arg
	    if ( ref($info{$parentarg}) ) {
		push (@{$info{$parentarg}},$arg);
	    }
	    # create a new list with the parent value.
	    elsif ( $info{$parentarg} ) {
		my $val = $info{$parentarg};
		$info{$parentarg} = [];
		push (@{$info{$parentarg}},$val);
		push (@{$info{$parentarg}},$arg);
	    }
	    # hmm, args, but no parent arg yet?
	    # We'll just make a list, in case that makes sense.
	    else { 
		$info{$parentarg} = [];
		push (@{$info{$parentarg}},$arg);
	    }
	    next; # we handled this already, so skip to the next line.
	}

	# We've reached a blank line, or an error, so add
	# the collected data to the hash and clear out the
	# locals. If there is no info, then skip it (to handle errors).
	#
	# This also sets $1 and $2 for the 'else' case.
	#
	# yes, this skips deleted files.
	if ($line !~ m/^\.\.\.\s+(\w+)\s+(.*)/) {
	    if ($line =~ m/^(.*) - no such file/) {
		$info{"depotFile"} = $1;
		$info{"exists"} = 0;
		$info{"isDir"} = 0;
		$info{"error"} = "no such file";

		# create an empty hash and copy the local one into it.
		$filehash{$1}={};
		%{$filehash{$1}}=%info;

		push (@dircandidates,$1);
	    }
	    elsif ($info{"depotFile"} && $info{"headAction"} ne "delete") {
		my $name = $info{"depotFile"};
		my $shortname = $name;
		$shortname =~ s|.*/||;

		$info{"exists"} = 1;
		$info{"isDir"} = 0;
		$info{"error"} = 0;
		$info{"shortname"} = $shortname;

		# create an empty hash and copy the local one into it.
		$filehash{$name}={};
		%{$filehash{$name}}=%info;
	    }
	    %info = (); # clear out the local info;
	    next;
	}
	else {
	    $info{$1} = $2;
	}
    }
    close INPUT;

    # now, we go over the list of failed files, looking for ones that were
    # directories.
    if (@dircandidates) {
	my $quoted = "";
	foreach (@dircandidates) {
	    $quoted .= " \"$_\"";
	}
	if (!open(INPUT,"p4 dirs $quoted 2>&1 |")) {
	    return %filehash;
	}
	# if it's found, then it's a dir, and should
	# exist, and be a directory
	while (<INPUT>) {
	    next if m/is not under client/;
	    if (!m/^(.*) - no such file\(s\)\.$/) {
		$filehash{$1}{"isDir"} = 1;
		$filehash{$1}{"exists"} = 1;
	    }
	}
	close INPUT;
    }

    return %filehash;
}

sub GetUserInfo {
    my %retval = ();

    if (!open(INPUT,"p4 users 2>&1 |")) {
	return {};
    }

    while (<INPUT>) {
	chomp;
	m/(.*) <(.*)> \((.*)\) accessed (.*)/;
	$retval{$1} = [$2,$3,$4];
    }

    return %retval;
}

1;