# All rights reserved. Capella Computers Ltd. (C) 1997

# Copyright (C) 1997 Capella Computers Ltd.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# Any feedback should be sent to Oren Ben-Kiki (oren@capella.co.il).

# :FILE:
# A PERL package for invoking 'p4' functionality. This is tailored for the
# particular use we make of p4, and not a general-purpose package.

use strict;
use English;

package P4;				# P4 operations.

# PACKAGE VARIABLES:

my $p4path = $ENV{P4PATH};		# Path to p4 installation.
defined($p4path)
    || die("P4PATH environment variable is not set.\n");
my $p4exe = "$p4path/lib/p4";		# Where the p4 executable is.

my $p4temp = $ENV{P4TEMP};		# Path to p4 temporary files.
defined($p4temp)
    || die("P4TEMP environment variable is not set.\n");

my $p4user = $ENV{P4USER};		# P4 user id.
defined($p4user)
    || die("P4USER environment variable is not set.\n");

my $p4client = $ENV{P4CLIENT};		# P4 client id.
defined($p4client)
    || die("P4CLIENT environment variable is not set.\n");

my $p4root = $ENV{P4ROOT};		# Root of client view.
defined($p4root)
    || die("P4ROOT environment variable is not set.\n");

# P4JOB is also an environment variable we use; however, being optional,
# it is only examined when it is asked for (in the current_job method).

my %do_unlock_on_error;			# Unlock depot on abnormal exit?

my $temp_file;				# Current temporary file, if any.

my $to_unlink;				# Unlink temp_file on close of from_p4?

# PUBLIC METHODS:

# Access variables:

# Return the current user.
sub current_user {
    return $p4user;
}

# Verify that the current user is (not) a specific one.
sub verify_current_user {
    my $valid = shift;			# List of valid users?
    # The rest of @::ARG is expected to contain the list of valid users.

    # Check them one by one
    my $user;
    foreach $user (@::ARG) {
	if ($p4user eq $user) {
	    $valid
		|| crash("Sorry, $p4user, this operation is blocked for ",
			join(' and ', @::ARG), '.');
	    # Be nice
	    return 1;
	}
    }

    !$valid
	|| crash("Sorry, $p4user, this operation is restricted to ",
	    join(' or ', @::ARG), " only.");

    # Be nice.
    return 1;
}

# Return the current client
sub current_client {
    return $p4client;
}

# Return the root directory of the client view.
sub view_root {
    return $p4root;
}

# Return the current job, which must be defined.
sub current_job {
    if (defined($ENV{P4JOB})) {
	return $ENV{P4JOB};
    } else {
	# Any argument means it is OK for it to be undefined.
	# The first argument is the return value.
	$#::ARG >= 0
	    || crash("P4JOB environment variable is not set.");
	return shift;
    }
}

# Convert a depot name to a name on the local disk.
sub depot_to_disk {
    my $name = shift;			# Depot name of file

    # Just replace the '//depot/ with the client's view root;
    # this assumes the client view is defined as:
    #	//depot/... //<client>/...
    # With $p4root as the root client directory.
    $name =~ s#^//depot#$p4root#;
    return $name;
}

# Job commands:

# These patterns are used to parse job descriptions.
my $job_header_pattern =		# Pattern for job header line.
	  "job(\\d+) "			# Job number.
	. "on (\\S+) "			# Creation date.
	. "by (\\w+)";			# User name.
my $job_data_pattern =			# Pattern for job data line.
	  "Data: (\\w+) "		# Job status.
	. "(\\d+|\\-) "			# Development change, or '-'.
	. "(\\w+|\\-) "			# Development client, or '-'.
	. "(\\d+|\\-) "			# Integration change, or '-'.
	. "(\\w+|\\-) "			# Integration client, or '-'.
	. "(\\d+|\\-) "			# Version, or '-'.
	. "(\\w+|\\-) "			# Reviewer name, or '-'.
	. "(\\d+) "			# Retry count (1-based).
	. "(.*)";			# Short title.

# Return the list of all jobs.
sub jobs {

    # Invoke p4 for a full list of jobs.
    read_from_p4('jobs', '-l');

    # Collect each line into a hash of jobs.
    my %jobs;
    my $line;
    while ($line = <FROM_P4>) {
	# Look for a line starting the description of a job.
	if ($line =~ /$job_header_pattern/) {
	    my $job = int($1);
	    my $created = $2;
	    my $user = $3;
	    # The description line comes after a blank line.
	    $line = <FROM_P4>;
	    $line = <FROM_P4>;
	    defined($line)
		|| crash("Bad output from 'p4 jobs'.");
	    if ($line =~ /$job_data_pattern/) {
		my $status = $1;
		my $dev_chg = $2;
		my $dev_client = $3;
		my $int_chg = $4;
		my $int_client = $5;
		my $version = $6;
		my $reviewer = $7;
		my $retry = $8;
		my $title = $9;
		my %record = (
		    'user' => $user,
		    'created' => $created,
		    'status' => $status,
		    'dev_chg' => $dev_chg,
		    'dev_client' => $dev_client,
		    'int_chg' => $int_chg,
		    'int_client' => $int_client,
		    'version' => $version,
		    'reviewer' => $reviewer,
		    'retry' => $retry,
		    'title' => $title,
		);
		$jobs{$job} = \%record;
	    } else {
		# This may be a pain if they are added on purpose.
		warn("Foreign job$1 created by $user on $created.\n");
	    }
	}
    }

    # Done.
    done_from_p4();
    return %jobs;
}

# Obtain a single job's record.
sub job_record {
    my $job = shift;		# Number of job to obtain record for.

    # Get p4 to print its definition.
    my $name = p4_job_name($job);
    read_from_p4('job', '-o', $name);

    # Parse the definition.
    my ($user, $created, $status);
    my ($dev_chg, $dev_client, $int_chg, $int_client);
    my ($version, $reviewer, $retry, $title, @issues, @description);
    my $in_descr = 0;
    my $line;
    while ($line = <FROM_P4>) {
	# Description ends when next field begins.
	if ($in_descr && $line =~ /^\S/) {
	    $in_descr = 0;
	}
	# Parse fields.
	if ($line =~ /^User:\s+(\w*)/) {
	    $user = $1;
	} elsif ($line =~ /^Date:\s+(\S*)/) {
	    $created = $1;
	} elsif ($line =~ /^Description:/) {
	    $line = <FROM_P4>;
	    defined($line)
		|| crash("Job description line is missing.");
	    $line !~ /<enter description here>/
		|| crash("Job $job does not exist.");
	    if ($line =~ /$job_data_pattern/) {
		$status = $1;
		$dev_chg = $2;
		$dev_client = $3;
		$int_chg = $4;
		$int_client = $5;
		$version = $6;
		$reviewer = $7;
		$retry = $8;
		$title = $9;
	    }
	    $in_descr = 1;
	# Parse description.
	} elsif ($in_descr) {
	    if ($line =~ /Issues: /) {
		@issues = split(/\s+/, $line);
		shift(@issues);
		shift(@issues);
	    } else {
		$line =~ s/^\s+//;
		push(@description, $line);
	    }
	}
    }

    # Make sure we've got everything we need.
      (defined($user)
    && defined($created)
    && defined($status)
    && defined($dev_chg)
    && defined($dev_client)
    && defined($int_chg)
    && defined($int_client)
    && defined($version)
    && defined($reviewer)
    && defined($retry)
    && defined($title))
	|| crash("Couldn't parse job definition.");

    # Done.
    done_from_p4();
    my %record = (
	'user' => $user,
	'created' => $created,
	'status' => $status,
	'dev_chg' => $dev_chg,
	'dev_client' => $dev_client,
	'int_chg' => $int_chg,
	'int_client' => $int_client,
	'version' => $version,
	'reviewer' => $reviewer,
	'retry' => $retry,
	'title' => $title,
	'issues' => \@issues,
	'description' => \@description,
    );
    return %record;
}

# Edit job description.
sub edit_job {
    my $job = shift;			# Id of job to edit.

    # Invoke p4 to invoke the editor, and pray the caller
    # does not trash the job.
    my $name = p4_job_name($job);
    call_sys('p4', "$p4exe job $name");

    # Be nice.
    return 1;
}

# Verify a job record contains the correct status.
sub verify_job_status {
    my $job = shift;			# Id of job in question.
    my $record = shift;			# (Reference) to job record.
    # The rest of @::ARG is expected to contain the list of valid status.

    my $job_status = $record->{status};
    my $status;
    foreach $status (@::ARG) {
	if ($job_status eq $status) {
	    # Be nice
	    return 1;
	}
    }

    crash("Job $job is in '$job_status' status ",
	"instead of in '", join("' status or in '", @::ARG), "' status.");
}

# Verify a job record contains the correct user.
sub verify_job_user {
    my $job = shift;			# Id of job in question.
    my $record = shift;			# (Reference) to job record.
    my $user = shift;			# Required user.

    my $job_user = $record->{user};
    $job_user eq $user
	|| crash("Job $job is developed by $job_user instead of by $user.");

    # Be nice.
    return 1;
}

# Verify that job record contains a valid reviewer
sub verify_job_reviewer {
    my $job = shift;			# Id of job in question.
    my $record = shift;			# (Reference) to job record.

    # Look for whoevere reviewed it.
    my $job_reviewer = $record->{reviewer};
    $job_reviewer ne '-'
	|| crash("Job $job has not been reviewed yet.");

    # Be nice.
    return 1;
}

# Verify a job record contains the correct development client.
sub verify_job_development_client {
    my $job = shift;			# Id of job in question.
    my $record = shift;			# (Reference) to job record.
    my $client = shift;			# Required client.

    my $job_client = $record->{dev_client};
    $job_client eq $client
	|| crash("Job $job is developed on $job_client instead of on $client.");

    # Be nice.
    return 1;
}

# Verify a job record contains the correct integration client.
sub verify_job_integration_client {
    my $job = shift;			# Id of job in question.
    my $record = shift;			# (Reference) to job record.
    my $client = shift;			# Required client.

    my $job_client = $record->{int_client};
    $job_client eq $client
	|| crash("Job $job is integrated on $job_client ",
		"instead of on $client.");

    # Be nice.
    return 1;
}

# Obtain the list of changes affecting a job.
sub job_fixes {
    my $job = shift;			# Job to obtain fixes of.

    # Get the fixes list.
    my $name = p4_job_name($job);
    read_from_p4('fixes', '-j', $name);

    # Collect results into a list of change.
    my @changes = ();
    my $line;
    while ($line = <FROM_P4>) {
	if ($line =~ /^$name fixed by change (\d+)/) {
	    my $change = $1;
	    push(@changes, $change);
	} else {
	    crash("Couldn't parse fixes list.");
	}
    }

    # Done.
    done_from_p4();
    return @changes;
}

# Create a new job. Note that its p4 status will be 'closed', not 'opened',
# otherwise it will stuff itself into any changelist around. Our status will
# be 'new', of course.
sub create_job {
    my $title = shift;			# Short (one line) title of job.
    # The rest of @::ARG is expected to contain the list of issues.

    # Create the new job.
    write_to_p4('job', '-i');
    print TO_P4 "Job: new\n";
    print TO_P4 "User: nobody\n";	# Not yet assigned to anyone.
    print TO_P4 "Status: new\n";	# Can't close it yet.
    print TO_P4 "Description:\n";
    print TO_P4 "\tData: new - - - - - - 1 $title\n";
    print TO_P4 "\tIssues: ", join(' ', @::ARG), "\n";
    done_to_p4();

    # Read the new job number.
    my $result = <FROM_P4>;
    my $job;
    if ($result =~ /Job job(\d*) saved./) {
	$job = int($1);
    } else {
	print "Expected: Job jobXXXXXX created.\n";
	print "Got:      $result";
	crash("Couldn't create new job.");
    }
    done_from_p4();

    # Now, close it. This means we don't have to worry about it changing
    # state in the future or getting itself stuffed into changelists.
    my $name = p4_job_name($job);
    write_to_p4('job', '-i');
    print TO_P4 "Job: ", $name, "\n";
    print TO_P4 "User: nobody\n";
    print TO_P4 "Status: closed\n";	# Can close it at last.
    print TO_P4 "Description:\n";
    print TO_P4 "\tData: new - - - - - - 1 $title\n";
    print TO_P4 "\tIssues: ", join(' ', @::ARG), "\n";
    done_to_p4();

    # Make sure it went well.
    expect_from_p4("Job $name saved.");

    # Done.
    return $job;
}

# Update a job. This expects a valid job record.
sub update_job {
    my $job = shift;			# Number of job to delete.
    my $record = shift;			# The updated record.

    my $user = $record->{user};		# The assigned user.
    my $created = $record->{created};	# The creation date.
    my $status = $record->{status};	# The job status.
    my $dev_chg = $record->{dev_chg};	# The development change, if any.
    my $dev_client = $record->{dev_client}; # The development client, if any.
    my $int_chg = $record->{int_chg};	# The integration change, if any.
    my $int_client = $record->{int_client}; # The integration client, if any.
    my $version = $record->{version};	# The version created by the job.
    my $reviewer = $record->{reviewer};	# The last reviewer of the job.
    my $retry = $record->{retry};	# The retry count.
    my $title = $record->{title};	# The short job title.
    my $issues = $record->{issues};	# The list of issues handled.
    my $description = $record->{description}; # The full description.

    # Send p4 the new record.
    my $name = p4_job_name($job);
    write_to_p4('job', '-i');
    print TO_P4 "Job: $name\n";
    print TO_P4 "User: $user\n";
    print TO_P4 "Status: closed\n";
    print TO_P4 "Date: $created 00:00:00\n"; # Cheating, but works.
    print TO_P4 "Description:\n";
    print TO_P4 "\tData: $status $dev_chg $dev_client $int_chg $int_client ",
    		"$version $reviewer $retry $title\n";
    print TO_P4 "\tIssues: ", join(' ', @$issues), "\n";
    print TO_P4 "\t", join("\t", @$description), "\n";
    done_to_p4();

    # Verify it went well.
    expect_from_p4("Job $name saved.");

    # Be nice.
    return 1;
}

# Delete a job. This assumes the operation is valid.
sub delete_job {
    my $job = shift;			# Number of job to delete.

    # Just ask p4 to do so.
    my $name = p4_job_name($job);
    read_from_p4('job', '-d', $name);
    expect_from_p4("Job $name deleted.");

    # Be nice.
    return 1;
}

# Branch commands:

# Create a new branch.
sub create_branch {
    my $branch = shift;			# Name of branch to create.
    my $title = shift;			# Title of branch.
    my $from = shift;			# Source files pattern.
    my $to = shift;			# Target file pattern.

    # Just ask p4 to do it.
    write_to_p4('branch', '-i');
    print TO_P4 "Branch: $branch\n";
    print TO_P4 "Description:\n";
    print TO_P4 "\t$title\n";
    print TO_P4 "View:\n";
    print TO_P4 "\t$from $to\n";
    done_to_p4();

    # Verify results.
    expect_from_p4("Branch $branch saved.");

    # Be nice.
    return 1;
}

# Integrate a branch. We have to deal with the horrid bug #350.
sub integrate_branch {
    my $branch = shift;			# Branch to integrate.
    my $change = shift;			# Change to do integration in.
    my $type = shift;			# Quick (buggy) or sure (slow)?
    # @::ARG is expected to contain any further arguments to 'integrate',
    # such as '-r'.

    if ($type eq 'quick') {
	# This is for cases were we don't care that not all files are
	# actually copied to the target of the branch - due to the change
	# being submitted soon, and the files got through 'p4 get'.
	call_sys('p4', "$p4exe integ", @::ARG, '-b', $branch, '-c', $change);

	# Be nice.
	return 1;
    }

    # Invoke p4 to do the integration.
    read_from_p4('integ', @::ARG, '-b', $branch, '-c', $change);

    # Collect the list of operations done.
    my ($line, %copy);
    while ($line = <FROM_P4>) {
	# We are looking for simple additions, which are
	# reported as a 'branch' operation. All the rest
	# are covered either by 'integ' or 'resolve'.
	print $line;
	if ($line =~ /^(.*)#.* \- branch from ([^#]*)#/) {
	    my $target = $1;
	    my $source = $2;

	    # First, we need to make sure we've got the
	    # source file on the local disk.
	    $::OUTPUT_AUTOFLUSH = 1; print "(get) ";
	    call_sys('p4', $p4exe, 'get', $source);
	    $::OUTPUT_AUTOFLUSH = 1; print "";

	    # Now we need to convert between the 'depot' file name and the
	    # local disk file name. To be absolutely safe, we should add a
	    # call to 'p4 where' in between, but since we expect the client
	    # views to always be the same, this overhead can be avoided.
	    $target = depot_to_disk($target);
	    $source = depot_to_disk($source);

	    # At last, we can copy the source file to the target file locally.
	    $::OUTPUT_AUTOFLUSH = 1; print "(cp) $target - copy $source\n";
	    copy_file($source, $target);
	}
    }

    # Done.
    done_from_p4();

    # Be nice.
    return 1;
}

# Verify that there's nothing to be done for branch integration.
sub verify_integrate_branch {
    my $branch = shift;			# Branch to verify integration of.

    # Ask p4 what needs to be done.
    read_from_p4('integ', '-n', '-b', $branch);

    # The expected response is that nothing is to be done.
    my $line = <FROM_P4>;
    chop($line);
    if ($line eq "All revision(s) already integrated."
     || $line eq "All revision(s) already integrated in pending change.") {
	done_from_p4();
	# Be nice.
	return 1;
    }

    # Print the list of required integrations.
    print "It seems the baseline has changed since the last synchronization:\n";
    print $line, "\n";
    while ($line = <FROM_P4>) {
	print $line;
    }
    crash("You need to synchronize your developement by running 'p4ws'.");
}

# Delete a branch.
sub delete_branch {
    my $branch = shift;			# Doomed branch.

    # Invoke p4 to delete it and verify results.
    read_from_p4('branch', '-d', $branch);
    expect_from_p4("Branch $branch deleted.");
}

# User commands:

# List all users.
sub users {

    # Ask p4 to do it.
    call_sys('p4', $p4exe, 'users');

    # Be nice.
    return 1;
}

# Change commands:

# List all changes (with optional filter)
sub changes {
    my $filter = shift;			# (Optional) filter on changes

    # If no filter asked for, just call p4 directly
    if (!defined($filter)) {
	call_sys('p4', $p4exe, 'changes');

	# Be nice.
	return 1;
    }

    # Read line by line and filter it
    read_from_p4('changes');
    my $line;
    while ($line = <FROM_P4>) {
	# Print only lines which match the filter.
	if ($line =~ /$filter/) {
	    print $line;
	}
    }
    done_from_p4();

    # Be nice.
    return 1;
}

# Obtain a single change record.
sub change_record {
    my $change = shift;			# Change to obtain record of.

    # Get p4 to print its definition.
    read_from_p4('change', '-o', $change);

    # Parse the definition.
    my ($user, $client, $created, $status, $title);
    my $line;
    while ($line = <FROM_P4>) {
	if ($line =~ /^User:\s+(\w*)/) {
	    $user = $1;
	} elsif ($line =~ /^Client:\s+(\S*)/) {
	    $client = $1;
	} elsif ($line =~ /^Date:\s+(\S*)/) {
	    $created = $1;
	} elsif ($line =~ /^Status:\s+(\S*)/) {
	    $status = $1;
	} elsif ($line =~ /^Description:/) {
	    $line = <FROM_P4>;
	    defined($line)
		|| crash("Change description line is missing.");
	    $line !~ /<enter description here>/
		|| crash("Change $change does not exist.");
	    if ($line =~ /^\s+(.*)/) {
		$title = $1;
	    }
	}
    }

    # Make sure we've got everything we need.
      (defined($user)
    && defined($client)
    && defined($created)
    && defined($status)
    && defined($title))
	|| crash("Couldn't parse change definition.");

    # Done.
    done_from_p4();
    my %record = (
	'user' => $user,
	'client' => $client,
	'created' => $created,
	'status' => $status,
	'title' => $title,
    );
    return %record;
}

# Create a new change.
sub create_change {
    my $user = shift;			# The user for the change.
    my $title = shift;			# The title of this change.

    # Ask p4 to create the change.
    write_to_p4('change', '-i');
    print TO_P4 "Change: new\n";
    print TO_P4 "Client: $p4client\n";
    print TO_P4 "User: $user\n";
    print TO_P4 "Status: new\n";
    print TO_P4 "Description:\n";
    print TO_P4 "\t$title\n";
    done_to_p4();

    # Now examine the results for the new change number.
    my $result = <FROM_P4>;
    if ($result =~ /^Change (\d*) created./) {
	done_from_p4();
	return $1;
    } else {
	# Something went wrong.
	crash("Expected: Change <#> created.\n",
	    "Got:      $result");
    }
}

# Submit a change.
sub submit_change {
    my $change = shift;			# Change to submit.

    # Invoke p4 to do it.
    read_from_p4('submit', '-c', $change);

    # Look for the updated change number.
    # Display the lines to the user in case they are of interest.
    my $renumbered;
    my $line;
    while ($line = <FROM_P4>) {
	print $line;
	if ($line =~ /^Change $change submitted./) {
	    $renumbered = $change;
	}
	if ($line =~ /Change $change renamed change (\d+) and submitted./) {
	    $renumbered = $1;
	}
    }

    # If we got the renumbering line, the submit was successful.
    defined($renumbered)
	|| crash("Attempt to submit change $change has failed.");

    # Close file.
    done_from_p4();

    # Return the new number of the change.
    return $renumbered;
}

# Delete a change.
sub delete_change {
    my $change = shift;			# Change to delete.

    # Invoke p4 to do it.
    read_from_p4('change', '-d', $change);
    expect_from_p4("Change $change deleted.");

    # Be nice.
    return 1;
}

# These map between integration operations and normal ones.
my %integ_to_work = (
    'integrate' => 'edit',
    'delete' => 'delete',
    'branch' => 'add'
);

# Convert an integration change operation to a normal operation.
sub integ_to_work {
    my $integ_op = shift;		# Operation to convert.

    my $work_op = $integ_to_work{$integ_op};
    defined($work_op)
	|| crash("Integration operation '$integ_op' is not recognized.");
    return $work_op;
}

# Get hash of files (and operations) of a change.
sub change_files {
    my $change = shift;			# Change to list details of

    # Ask p4 for a change description
    read_from_p4('describe', '-s', $change);

    # Look for file operation lines.
    my %change_files;
    my $line;
    while ($line = <FROM_P4>) {
	if ($line =~ m://depot/baseline/(\S+)#\d+ (\w+):) {
	    my $file = $1;
	    my $op = integ_to_work($2);
	    $change_files{$file} = $op;
	}
    }

    # Done.
    done_from_p4();
    return %change_files;
}

# Fix commands:

# Create a new fix.
sub create_fix {
    my $change = shift;			# Change to associate with job.
    my $job = shift;			# Job to associate with change.

    # Just invoke p4 to do it (verifying the results).
    my $name = p4_job_name($job);
    read_from_p4('fix', '-c', $change, $name);
    expect_from_p4("$name fixed by change $change.");

    # Be nice.
    1;
}

# Delete a fix.
sub delete_fix {
    my $change = shift;			# Change to disassociate with job.
    my $job = shift;			# Job to disassociate with change.

    # Just invoke p4 to do it (verifying the results).
    my $name = p4_job_name($job);
    read_from_p4('fix', '-d', '-c', $change, $name);
    expect_from_p4("Deleted fix $name by change $change.");

    # Be nice.
    1;
}

# File commands:

# Get files from depot.
sub get_files {
    # @::ARG is expected to contain the list of files.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, 'get', @::ARG);

    # Be nice.
    return 1;
}

# Refresh (unopened) files from depot.
sub refresh_files {
    # @::ARG is expected to contain the list of files.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, 'refresh', @::ARG);

    # Be nice.
    return 1;
}

# Print files from depot.
sub print_files {
    # @::ARG is expected to contain the list of files.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, 'print', @::ARG);

    # Be nice.
    return 1;
}

# Diff files to the depot.
sub diff_files {
    # @::ARG is expected to contain the list of files.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, 'diff', @::ARG);

    # Be nice.
    return 1;
}

# Resolve (integrated) files from depot.
sub resolve_files {
    my $reresolve = shift;		# Is this a re-resolve?
    # @::ARG is expected to contain the list of files,
    # and any relevant control arguments.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, ($reresolve ? 'reresolve' : 'resolve'), @::ARG);

    # Be nice.
    return 1;
}

# Verify there's nothing more to do to resolve files.
sub verify_resolve_files {
    my $view = shift;			# View for files to resolve

    # Ask p4 whether there's anything to do.
    read_from_p4('resolve', '-n', $view);

    # Expect that no files need to be resolved.
    my $line = <FROM_P4>;
    chop($line);
    if ($line eq "$view - no file(s) to resolve.") {
	done_from_p4();
	# Be nice.
	return 1;
    }

    # Print the list of required integrations.
    print "It seems you didn't completely resolve the last synchronization:\n";
    print $line, "\n";
    while ($line = <FROM_P4>) {
	print $line;
    }
    crash("You need to synchronize your developement by running 'p4ws'.");
}

# Verify there's nothing more to do to get files.
sub verify_get_files {
    my $view = shift;			# View for files to resolve

    # Ask p4 whether there's anything to do.
    read_from_p4('get', '-n', $view);

    # Expect that no files need to be resolved.
    my $line = <FROM_P4>;
    chop($line);
    if ($line eq "$view - file(s) up-to-date.") {
	done_from_p4();
	# Be nice.
	return 1;
    }

    # Print the list of required integrations.
    print "It seems you don't have the latest version of $view:\n";
    print $line, "\n";
    while ($line = <FROM_P4>) {
	print $line;
    }
    crash("You can get the latest version using 'p4fg'.");
}

# Revert files (to before change started).
sub revert_files {
    my $change = shift;			# Change to revert files for
    my $del_opt = shift;		# '-d' if we're to delete files.
    # @::ARG is expected to contain the change number + the list of files.

    if ($del_opt eq '') {
	# Invoke p4, hoping for the best.
	call_sys('p4', $p4exe, 'revert', '-c', $change, @::ARG);
	# Be nice.
	return 1;
    }

    # Read all reverted files
    read_from_p4('revert', '-c', $change, @::ARG);
    my $line;
    while ($line = <FROM_P4>) {
	print $line;
	if ($line =~ /([^#]*)#.* \- was branch, cleared/) {
	    my $file = depot_to_disk($1);
	    $::OUTPUT_AUTOFLUSH = 1; print "(rm) $file\n";
	    remove_file($file);
	}
	if ($line =~ /([^#]*)#.* \- was add, abandoned/) {
	    my $file = depot_to_disk($1);
	    $::OUTPUT_AUTOFLUSH = 1; print "(rm) $file\n";
	    remove_file($file);
	}
    }

    # Done.
    done_from_p4();

    # Be nice.
    return 1;
}

# Delete files.
sub delete_files {
    # @::ARG is expected to contain the change number + the list of files.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, 'delete', '-c', @::ARG);

    # Be nice.
    return 1;
}

# Edit files.
sub edit_files {
    # @::ARG is expected to contain the change number + the list of files.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, 'edit', '-c', @::ARG);

    # Be nice.
    return 1;
}

# Add files.
sub add_files {
    # @::ARG is expected to contain the change number + the list of files.

    # Invoke p4, hoping for the best.
    call_sys('p4', $p4exe, 'add', '-c', @::ARG);

    # Be nice.
    return 1;
}

# Return all opened files and their operations.
sub opened_files {
    my $job = shift;			# Job to get file operations for.
    my $record = shift;			# (Reference to) job's record.
    my $must_have = shift;		# Must have opened files?

    # Do not insist on files by default.
    if (!defined($must_have)) {
	$must_have = 0;
    }

    # Ask p4 for the list.
    my $user = $record->{user};
    my $retry = $record->{retry};
    my $status = $record->{status};
    my $prefix = ($status eq 'work'
		    ? "//depot/$user/$job-$retry"
		    : "//depot/baseline");
    read_from_p4('opened', $prefix . '/...');

    # Collect files into a hash table.
    my %job_files;
    my $line;
    while ($line = <FROM_P4>) {

	# Verify that there _are_ any opened files, if requested.
	if ($line =~ /not opened on this client/) {
	    !$must_have
		|| crash("Job $job (attempt #$retry) by $user ",
			"has no opened files.");

	# Look for file operations.
	} elsif ($line =~ m:$prefix/(\S+)#\d+ \- (\w+):) {
	    my $file = $1;
	    my $op = $2;
	    $job_files{$file} = $op;

	# Something went wrong...
	} else {
	    crash($line, "Bad output from 'p4 opened'.");
	}
    }

    # Done.
    done_from_p4();
    return %job_files;
}

# Add into an array any opened files from a previous submit of a job.
sub old_opened_files {
    my $job = shift;			# Job to get file operations for.
    my $record = shift;			# (Reference to) job's record.
    my $job_files = shift;		# (Reference to) current job files.

    # Due to our protection scheme, p4 only allows the following to
    # the integrator.
    my $user = $record->{user};
    my $retry = $record->{retry};
    $ENV{P4USER} = 'integ';
    read_from_p4('integ', '-n', '-r', '-b', "$user-$job-$retry");
    $ENV{P4USER} = $p4user;

    # Parse all lines.
    my $line;
    while ($line = <FROM_P4>) {
	if ($line =~ m://depot/baseline/(\S+)#\d+ \- (\w+):) {
	    my $file = $1;
	    my $op = integ_to_work($2);
	    # Only add the file if it isn't in the current change.
	    if (!defined($job_files->{$file})) {
		$job_files->{$file} = $op;
	    }
	}
    }
    done_from_p4();

    # Be nice.
    return 1;
}

# Obliterate files. This is not part of any change!
sub obliterate_files {
    # @::ARG is expected to contain the list of files.

    # Due to our protection scheme, p4 only allows the following to
    # the integrator.
    $ENV{P4USER} = 'integ';
    call_sys('p4', $p4exe, 'obliterate', '-y', @::ARG);
    $ENV{P4USER} = $p4user;

    # Be nice.
    return 1;
}


# Version commands:

# Obtain the currently used version number.
sub get_version {

    # The last used version number is stored in a special job.
    read_from_p4('job', '-o', 'version');

    # Look for the version number.
    my $version;
    my $line;
    while ($line = <FROM_P4>) {
	# Job does not exist - "version 0".
	if ($line =~ /<enter description here>/) {
	    $version = 0;
	    last;
	}
	# Job exists - contains used version number in description.
	if ($line =~ /Version: (\d+)/) {
	    $version = $1;
	    last;
	}
    }

    # Verify we got it.
    defined($version)
	|| crash("Bad output from 'p4 job'.");

    # Done.
    done_from_p4();
    return $version;
}

# Set the version number.
sub set_version {
    my $version = shift;		# Version number to set to.

    # Create/Update the version job.
    write_to_p4('job', '-i');
    print TO_P4 "Job: version\n";
    print TO_P4 "User: version\n";
    print TO_P4 "Status: closed\n";
    print TO_P4 "Description:\n";
    print TO_P4 "\tVersion: ", $version, "\n";
    done_to_p4();

    # Verify results.
    expect_from_p4("Job version saved.");

    # Be nice.
    return 1;
}

# Create a version.
sub create_version {
    my $version = shift;		# Version of project.
    my $job = shift;			# The job creating this version.
    my $record = shift;			# (Reference to) job's record.
    my $freeze = shift;			# Create frozen version?

    # By default, do not freeze.
    if (!defined($freeze)) {
	$freeze = 0;
    }

    # Create the new version. Note that the version only covers the baseline.
    write_to_p4('label', '-i');
    print TO_P4 "Label: L$version\n";
    print TO_P4 "Owner: ", ($freeze ? 'version' : $p4user), "\n";
    print TO_P4 "Description:\n";
    my $user = $record->{user};
    my $reviewer = $record->{reviewer};
    my $title = $record->{title};
    print TO_P4 "\tData: $job $user $reviewer $title\n";
    print TO_P4 "View:\n";
    print TO_P4 "\t//depot/baseline/... //L$version/...\n";
    done_to_p4();

    # Verify results.
    expect_from_p4("Label L$version saved.");

    # Be nice.
    return 1;
}

# Synchronize the version with the current state of affair.
sub sync_version {
    my $version = shift;		# Version to sync version of.

    # Call p4 to do it.
    call_sys('p4', $p4exe, 'labelsync', '-l', "L$version");

    # Be nice.
    return 1;
}

# Get list of all versions.
sub versions {

    # Invoke p4 for the full list.
    read_from_p4('labels');

    # Parse results.
    my %versions;
    my $line;
    while ($line = <FROM_P4>) {
	if ($line =~ /Label L(\d+) (\S+) 'Data: (\d+) (\w+) (\w+) (.*)'/) {
	    my $version = $1;
	    my $created = $2;
	    my $job = $3;
	    my $user = $4;
	    my $reviewer = $5;
	    my $title = $6;
	    my %record = (
		'created' => $created,
		'job' => $job,
		'user' => $user,
		'reviewer' => $reviewer,
		'title' => $title,
	    );
	    $versions{$version} = \%record;
	} else {
	    # This may be a pain if they are added on purpose.
	    warn($line);
	    warn("- is a foreign label.\n");
	}
    }

    # Done.
    done_from_p4();
    return %versions;
}

# PRIVATE METHODS:

# Convert an integer job number to p4's job name.
sub p4_job_name {
    my $job = shift;			# Our job identifier

    # Numbers are stored as JobXXXXXX in p4.
    if ($job =~ /^\d+$/) {
	return sprintf("job%06d", $job);

    # Lock jobs are stored as lock_XX and owner_XX in p4.
    } elsif ($job =~ /lock_\S+/ || $job =~ /owner_\S+/) {
	return $job;

    # Otherwise, it is some bad name.
    } else {
	crash("Bad job name '$job'.");
    }
}

# Invoke p4 in various ways:

# Invoke a system command.
sub call_sys {
    my $msg = shift;			# Message in case it fails.

    # $::OUTPUT_AUTOFLUSH = 1; print join(' ', @::ARG), "\n";
    my $status = system(join(' ', @::ARG)) / 256;
    $status == 0
	|| crash("$msg failed: status $status.");

    # Be nice.
    return 1;
}


# Invoke a p4 command and read from it via FROM_P4.
sub read_from_p4 {

    open(FROM_P4, "$p4exe " . join(' ', @::ARG) . ' 2>&1 |')
	|| crash("Can't run p4: $!");

    # Be nice.
    return 1;
}

# Close read connection to p4.
sub done_from_p4 {

    close(FROM_P4)
	|| crash("Can't disconnect from p4: $!");

    # Can't always delete temporary file since maybe both to_p4 and
    # from_p4 were called together; in this case, closing the first
    # from_p4 should not delete the temporary file - only the second
    # should.
    if (defined($temp_file) && defined($to_unlink)) {
	unlink($temp_file)
	    || warn("Can't delete $temp_file: $!");
	$temp_file = undef;
	$to_unlink = undef;
    }

    # Be nice.
    return 1;
}

# Invoke a p4 command and send to its standard input.
# Output from p4 is collected into a temporary file.
sub write_to_p4 {

    $temp_file = "$p4temp/" . abs($::PID) . '.cp4';
    open(TO_P4, '| ' . "$p4exe " . join(' ', @::ARG) . ' > ' . $temp_file)
	|| crash("Can't run p4: $!");

    # Be nice.
    return 1;
}

# Close write connection to p4; open read connection to result.
sub done_to_p4 {

    close(TO_P4)
	|| crash("Can't disconnect from p4: $!");

    # Now open the temporary file through the same FROM_P4 file handle;
    # this allows other methods which read from it to be applied to both
    # output from from_p4 and from to_p4. Signal done_from_p4 to delete
    # the file when we are done.
    open(FROM_P4, $temp_file)
	|| crash("Can't open $temp_file: $!");
    $to_unlink = 1;

    # Be nice.
    return 1;
}

# Examine p4 output to check for expected results.
sub expect_from_p4 {
    # @::ARG is expected to be a list of acceptable alternatives.

    # Obtain the result.
    my $result = <FROM_P4>;
    chop($result);
    defined($result)
	|| crash("p4 was mysteriously silent.");

    # Examine all alternatives.
    my $expect;
    foreach $expect (@::ARG) {
	if ($expect eq $result) {
	    done_from_p4();
	    # Be nice.
	    return 1;
	}
    }

    # Isn't there - print a nice message.
    my $prefix = 'Expected: ';
    foreach $expect (@::ARG) {
	print $prefix, $expect, "\n";
	$prefix = 'Or:       ';
    }
    crash("Got:      $result");
}

# HIGH LEVEL COMMANDS:

# The following provide some high-level behaviour which is
# not directly available from p4.

# Depot-level lock commands:

# Lock depot-level entity.
sub lock {
    my $what = shift;			# What to lock.
    my $what_for = shift;		# Reason for lock.

    # Create a job with the name 'lock_<something>'; if it exists, it indicates
    # the lock is owned by someone else. This turns out to be an atomic
    # test-and-set operation.

    # Create the new job.
    write_to_p4('job', '-i');
    print TO_P4 "Job: lock_$what\n";
    print TO_P4 "User: lock\n";
    print TO_P4 "Status: closed\n";
    print TO_P4 "Description:\n";
    print TO_P4 "\tIndicates $what is locked.\n";
    done_to_p4();

    # Read the new job number.
    my $line = <FROM_P4>;

    # Saved means job didn't previously exist.
    if ($line =~ /Job lock_$what saved./) {
	done_from_p4();

	# By default, release the lock if something goes wrong.
	$do_unlock_on_error{$what} = 1;

	# Record the new owner of the lock.
	set_locker($what, $p4user, $what_for);

	# Be nice
	return 1;
    }

    # Unchanged means lock already exists - owned by someone else.
    if ($line =~ /Job lock_$what not changed./) {
	my ($locker, $reason) = get_locker($what);
	die("Sorry, $what is already locked by $locker for $reason.\n");
    }

    # Anything else is a cause to worry.
    print "### Creating $what lock:\n";
    print $line;
    while ($line = <FROM_P4>) {
	print $line;
    }
    die("p4 failed to create $what lock.\n");
}

# Store the owner of a lock so we'll be able to report it later.
sub set_locker {
    my $what = shift;			# What has been locked.
    my $locker = shift;			# New lock owner.
    my $what_for = shift;		# Reason for lock.

    # Create/update lock owner record.
    write_to_p4('job', '-i');
    print TO_P4 "Job: owner_$what\n";
    print TO_P4 "User: $locker\n";
    print TO_P4 "Status: closed\n";
    print TO_P4 "Description:\n";
    print TO_P4 "\tReason: $what_for\n";
    done_to_p4();

    # Verify results.
    expect_from_p4("Job owner_$what saved.", "Job owner_$what not changed.");

    # Be nice.
    return 1;
}

# Obtain lock owner and reason for lock.
sub get_locker {
    my $what = shift;			# Lock for what?

    # Ask p4 for the data.
    read_from_p4('job', '-o', "owner_$what");

    # Parse each line.
    my ($locker, $what_for);
    my $line;
    while ($line = <FROM_P4>) {
	# User is the owner of the lock.
	if ($line =~ /^User:\s+(\w+)/) {
	    $locker = $1;
	}
	# Our 'Reason:' line is the reason for the lock.
	if ($line =~ /\s+Reason:\s+(.*)/) {
	    $what_for = $1;
	}
    }
    done_from_p4();

    # This could happen due to race conditions, for example.
    if (!defined($what_for)) {
	$locker = 'nobody';
	$what_for = 'no reason';
    }

    # Done.
    return ($locker, $what_for);
}

# Check whether something is locked.
sub check_lock {
    my $what = shift;			# What to check lock of.

    # Look for the lock job.
    read_from_p4('job', '-o', "lock_$what");

    # Look for the description line.
    my $line;
    while ($line = <FROM_P4>) {
	# This means job does not exists - whatever it is isn't locked.
	if ($line =~ /<enter description here>/) {
	    # Not locked.
	    done_from_p4();
	    return 0;
	}
    }

    # Is locked.
    done_from_p4();
    return 1;
}

# Verify something is locked.
sub verify_lock {
    my $what = shift;			# What to verify lock of.

    # Make sure whatever it is is locked.
    check_lock($what)
	    || die("It seems $what is not locked.\n");

    # Be nice.
    return 1;
}

# Release a lock.
sub unlock {
    # @::ARG is expected to contain the list of things to unlock.

    # If no arguments were given, release all locks
    if ($#::ARG < 0) {
	@::ARG = keys(%do_unlock_on_error);
    }

    # Loop on all locks.
    my $what;
    foreach $what (@::ARG) {
	# Turn this off, so if anything else goes wrong, we won't have a loop.
	if (defined($do_unlock_on_error{$what})) {
	    delete($do_unlock_on_error{$what});
	}
	# Delete the lock job first, then the owner.
	delete_job("lock_$what");
	delete_job("owner_$what");
    }

    # Be nice.
    return 1;
}

# Control automatic unlocking on abnormal termination.
sub unlock_on_error {
    my $what = shift;			# What lock to control
    my $to_unlock = shift;		# 1 - unlock, 0 - do not.

    if ($to_unlock) {
	$do_unlock_on_error{$what} = 1;
    } elsif (defined($do_unlock_on_error{$what})) {
	delete($do_unlock_on_error{$what});
    }

    # Be nice.
    return 1;
}

# Die while unlocking depot.
sub crash {
    # @::ARG is expected to contain error message, as usual for 'die'.
    print(@::ARG, "\n");

    # On error, do brutal unlock; this prevents loops, sidesteps the issue
    # of <FROM_P4> and so on. Ignore errors; nothing can be done, and an
    # error message will be given anyway.
    my $printed = 0;
    my $what;
    foreach $what (keys %do_unlock_on_error) {
	if (!$printed) {
	    print "### Remove broken locks...\n";
	    $printed = 1;
	}
	system($p4exe, 'job', '-d', "lock_$what");
	system($p4exe, 'job', '-d', "owner_$what");
    }

    # Give up the ghost.
    exit(1);
}

# File level lock commands:

# Convert a general depot file name to a lock file name.
sub depot_to_lock {
    my $name = shift;			# Depot file name

    # If it is a baseline name, strip that
    $name =~ s#//depot/baseline/##;

    # If it is a development name, strip that
    $name =~ s#//depot/\w+/\d+\-\d+/##;

    return $name;
}

# Obtain the list of all locked files.
sub locked_files {
    # Ask p4 for the list, stored in a special job.
    read_from_p4('job', '-o', 'locked_files');

    # Skip all irrelevant header lines.
    my $line;
    while ($line = <FROM_P4>) {
	if ($line =~ /^Description:/) {
	    last;
	}
    }

    # Start filling the locked files hash.
    my %files;
    while ($line = <FROM_P4>) {
	if ($line =~ /\s+(\d+) (\S+)/) {
	    my $job = $1;
	    my $file = $2;
	    $files{$file} = $job;
	}
    }

    # Done.
    done_from_p4();
    return %files;
}

# Set the list of locked files. Note that this overrides the complete list, not
# just adds entries. It should be done only when protected by a depot lock.
sub lock_files {
    my $files = shift;			# (Reference to) locked files hash

    # Ask for the current job definition,
    write_to_p4('job', '-i');
    print TO_P4 "Job: locked_files\n";
    print TO_P4 "User: lock\n";
    print TO_P4 "Status: closed\n";
    print TO_P4 "Description:\n";
    print TO_P4 "\tList of locked depot files:\n";

    # Loop on all entries
    my ($file, $job);
    while (($file, $job) = each(%$files)) {
	print TO_P4 "\t$job $file\n";
    }

    # Submit to p4; verify results.
    done_to_p4();
    expect_from_p4("Job locked_files saved.",
		    "Job locked_files not changed.");

    # Be nice.
    return 1;
}

# Report utilities:

# Print list of all locks.
sub print_locks {
    # Ask for the full list of jobs.
    read_from_p4('jobs');

    # Print nice column titles.
    print "Job\tCreated   \tUser\tReason\n";
    print "---\t----------\t----\t------\n";

    # Look for 'owner' locks.
    my $line;
    while ($line = <FROM_P4>) {
	if ($line =~ /owner_(\S+) on (\S+) by (\w+) 'Reason: (.*)'/) {
	    my $job = $1;
	    my $date = $2;
	    my $user = $3;
	    my $reason = $4;
	    # Print it nicely.
	    print $job, "\t";
	    print $date, "\t";
	    print $user, "\t";
	    print $reason, "\n";
	}
    }
    done_from_p4();

    # Be nice.
    return 1;
}

# Display a file log.
sub print_files_log {
    # @::ARG is expected to contain the list of files.

    # Invoke p4 to get raw files log.
    read_from_p4('filelog', @::ARG);

     my $pattern =
	  "#(\\d+) "			# File version number.
	. "change \\d+ "		# Number of change (ignored).
	. "\\S+ "			# File operation (pretty useless).
	. "on (\\S+) "			# Date of integration.
	. "by \\S+ "			# Integrator (always 'integ').
	. "'Integrate (\\d+)\-(\\d+) "	# Job and retry number.
	. "by (\\w+)\\. '";		# Developer.

    # Filter out noise lines.
    my $line;
    while ($line = <FROM_P4>) {
	# detect file name lines:
	if ($line =~ /^\S+$/) {
	    print "\n", $line, "\n";
	    # Print nice column titles.
	    print "Ver.\tJob\tRe\tUser\tDate\n";
	    print "----\t---\t--\t----\t----\n";
	}
	# Parse relevant file history lines:
	if ($line =~ /$pattern/) {
	    my $file_version = $1;
	    my $date = $2;
	    my $job = $3;
	    my $retry = $4;
	    my $user = $5;
	    print ' ', $file_version, "\t";
	    print $job, "\t";
	    print $retry, "\t";
	    print $user, "\t";
	    print $date, "\n";
	}
    }

    # Be nice.
    return 1;
}

# Verification utilities:

# Verify that development/integration is ready.
sub verify_job_ready {
    my $job = shift;			# Id of job to verify
    my $record = shift;			# (Reference to) job's record

    # Verify that there's nothing to be done to re-integrate the work branch,
    # or to resolve conflicts from previous integrations.
    my $user = $record->{user};
    my $retry = $record->{retry};
    my $branch = "$user-$job-$retry";
    my $status = $record->{status};
    my $flag = ($status eq 'work' ? '' : '-r');
    P4::verify_integrate_branch($branch, $flag);
    P4::verify_resolve_files('//depot/baseline/...');
    P4::verify_resolve_files("//depot/$user/$job-$retry/...");

    # Adapt directory and messages to the mode we're working in.
    my $dir = P4::view_root()
    	. ($status eq 'work' ? "/$user/$job-$retry" : '/baseline');
    my $start_msg = ($status eq 'work'
			? "### Verify development directory...\n"
			: "### Verify integration directory...\n");
    my $fail_msg = ($status eq 'work'
    ? "Work on job $job (attempt #$retry) by $user is NOT ready for review.\n"
    : "Integration of job $job (attempt #$retry) by $user is NOT confirmed.\n");

    $::OUTPUT_AUTOFLUSH = 1;
    print $start_msg;

    # This verifies the developer-provided invariant.
    verify_dir($dir, $status, $job, $record->{version})
	|| crash($::EVAL_ERROR, $fail_msg);

    # Be nice.
    return 1;
}

# Verify that a specified directory satisfies the invariant.
sub verify_dir {
    my $dir = shift;			# Directory to verify.
    $::p4mode = $::p4mode = shift;	# The mode (work/integ/base).
    $::p4job = $::p4job = shift;	# The relevant job number.
    $::p4version = $::p4version = shift; # The project version.
    					# The last three are repeated
					# twice to shut 'strict' up; they
					# are to be used by 'verify.pl'.

    # What exactly does a verification include is up to the development team.
    # What we do is execute a 'verify.pl' script which is expected to exist
    # in the top-level directory. If it does not call 'die', it is assumed
    # that the work directory passes the verification.
    chdir($dir)
	|| crash("chdir($dir): $!");

    # Do the actual verification.
    return do './verify.pl';
}

# Verify that job would not lock already-locked files.
# Return the updated files to be locked if work is ended.
sub verify_job_locks {
    my $job = shift;			# Job to verify locks of.
    my $record = shift;			# (Reference to) job's record

    # Print nice message in case things go wrong.
    print "### Verify job file locks...\n";

    # We need to get the files to be locked for this job.
    # First, look for files opened in the development branch.
    my %job_files = opened_files($job, $record, 1);

    # Next, add into it the files from previous submits of the same job, if any.
    old_opened_files($job, $record, \%job_files);

    # This is the list of the files already locked.
    my %locked_files = locked_files();

    # Start adding the job files to the lock files,
    # informing the caller of any collisions.
    my $collisions = 0;
    my $job_file;
    foreach $job_file (keys(%job_files)) {
	my $lock_job = $locked_files{$job_file};
	if (defined($lock_job)) {
	    print "$job_file is locked by job $lock_job\n";
	    $collisions++;
	} else {
	    $locked_files{$job_file} = $job;
	}
    }

    # Make sure there were no collisions.
    my $user = $record->{user};
    my $retry = $record->{retry};
    !$collisions
	|| crash("Job $job (attempt #$retry) by $user ",
		"conflicts with submitted jobs.");

     # Done.
     return %locked_files;
}

# FILE SYSTEM UTILITIES:

# The following should really be factored out to a separate package.
# This is the UNIX implementation (which will work on DOS if you have
# something like the MKS UNIX utilities). A DOS version is not that
# trivial, it turns out - but who wants to work in DOS anyway? :-)

# Delete a directory, including any sub files/directories.
sub remove_dir {
    my $dir = shift;			# Directory to delete.

    # This will remove it if at all possible.
    call_sys("remove directory $dir", "rm -rf $dir");

    # Be nice.
    return 1;
}

# Remove a file.
sub remove_file {
    my $file = shift;			# File to delete.

    # This will remove it if at all possible.
    call_sys("remove file $file", "rm -f $file");

    # Be nice.
    return 1;
}


# Copy one file to another.
sub copy_file {
    my $source = shift;			# File to copy from
    my $target = shift;			# File to copy into

    # First, we need to make sure the target directory exists.
    # This assumes that there is always a directory component
    # in the name, which is safe in our case.
    my $dir = $target;
    $dir =~ s:/[^/]*$::;
    if (! -d $dir) {
	call_sys("create directory $dir", "mkdir -p $dir");
    }

    # Now we can safely call 'cp'.
    call_sys("copy $source to $target", "cp -pf $source $target");

    # Be nice
    return 1;
}

# Be nice.
1;