#!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. 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
sub GetFileInfo {
my @input_files = @_;
my %filehash;
my $line;
my %info;
# 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 |")) {
print "Status: 200 OK\n";
print "Content-type: text/html\n\n";
print "Unable to open p4...\n";
print "
Sorry, unable to open a pipe to 'p4'...
\n";
exit(0);
}
foreach $line () {
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).
# files with errors (most likely "file not found")
# will not show up in the output. We could handle this better,
# of course.
#
# This also sets $1 and $2 for the 'else' case.
#
# yes, this skips deleted files.
if ($line !~ m/^\.\.\.\s+(\w+)\s+(.*)/) {
if ($info{"depotFile"} && $info{"headAction"} ne "delete") {
my $name = $info{"depotFile"};
my $shortname = $name;
$shortname =~ s|.*/||;
# 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;
return %filehash;
}
sub GetUserInfo {
my %retval = ();
if (!open(INPUT,"p4 users 2>&1 |")) {
return {};
}
while () {
chomp;
m/(.*) <(.*)> \((.*)\) accessed (.*)/;
$retval{$1} = [$2,$3,$4];
}
return %retval;
}
1;