#!/usr/bin/env perl
#
# $Id: //guest/daniel_kionka/save-opened/save-opened.pl#3 $
#
# Copyright (c) 2005 Daniel P. Kionka; all rights reserved
#
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
#
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
# LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
# OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#

use strict;
use warnings;

use File::Basename;
use File::Copy;
use File::Path;
use File::Spec;
use Getopt::Std;

#-----------
# variables
#-----------

# constants
my $PROG = basename($0);
my @reqP4 = qw(P4CLIENT P4PORT P4USER);

# defaults
my $tmpdir = (defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/tmp");
my $dirOutBase = "$tmpdir/save-opened";

# for config file
my %configOpts;

# command line options
my $verbose = 0;
my $dirOut;

# info from p4
my $p4Root;

#-----------
# functions
#-----------

#
# Message about this program and how to use it
#
sub usage()
{
    print STDERR << "EOF";

This program saves all open files in the p4 client.

usage: $0 [-dhov] [-c client] [-d output-directory]

-c client : override P4CLIENT
-d outdir : output directory
-o        : overwrite output directory
-h        : this (help) message
-v        : verbose output

EOF
    exit 1;
}


#
# set command line options
#
sub setOptions()
{
    my %opt;
    my $opt_string = 'c:dhov';
    getopts( "$opt_string", \%opt ) || usage();
    usage() if $opt{h};

    foreach my $arg (@ARGV) {
            print "arg = $arg\n";
    }

    # verify p4 variables are set
    verbose("p4 values:");
    foreach my $key (@reqP4) {
        $ENV{$key} = $configOpts{$key} if (defined($configOpts{$key}));
        die "Missing p4 variable: $key" if (! defined($ENV{$key}));
        verbose("$key = $ENV{$key}");
    }

    # set global flags
    $verbose = $opt{v};
    $dirOut = (defined($opt{d}) ? $opt{d} : "$dirOutBase/$ENV{P4CLIENT}");

    # rename old output dir unless -o
    if (! defined($opt{o})) {
        my $old = "$dirOut-old";
        rmtree($old) if (-d $old);
        rename($dirOut, $old) if (-d $dirOut);
        rmtree($dirOut) if (-d $dirOut); # in case rename fails
        die "Can not remove: $dirOut" if (-d $dirOut);
    }
}


sub verbose($)
{
    my ($message) = @_;
    print "$PROG: $message\n" if ($verbose);
}


#
# read configuration
#
sub readP4Set()
{
    # start with p4 set values
    verbose("reading p4 set...");
    open P4SET, "p4 set |" || die "Bad can not run p4 set.";
    while (defined(my $line = <P4SET>)) {
	my ($key, $val) = ($line =~ m/^(\S+)=(\S+)/);
	die "Bad p4 set line: $line" if (! defined($val));
	verbose("$key = $val");
	$configOpts{$key} = $val;
    }
    close P4SET;
}


sub findRoot()
{
    # parse p4 client
    verbose("parsing p4 client...");
    open CLIENT, "p4 client -o $ENV{P4CLIENT} |" || die "p4 client";
    while (defined(my $line = <CLIENT>)) {
	chomp $line;
	# ignore mullti-line values
	my ($key, $val) = ($line =~ m/^(\S*):\s*(.*)/);
	if (defined($val)) {
	    verbose("$key = $val");
            $val =~ s,\\,/,g;
            $p4Root = $val if ($key eq "Root");
	}
    }
    close CLIENT;
    die "no root in client" if (! defined($p4Root));
    # we will be looking for files with relative paths
    chdir($p4Root);
}


#
# find the relative path to the local file from a depot file
#
sub findLocal($)
{
    my ($depot) = @_;
    my $where = `p4 where "$depot"`;
    chomp $where;
    my ($depot2, $view, $local) = ($where =~ m,^(//.+) (//.+) (.+),);
    verbose("3rd: $local");
    $local =~ s,\\,/,g;
    $local =~ s,^$p4Root/,,;
    verbose("local = $local");
    return $local;
}


#
# do the build-boot-strap
#
sub doSave()
{
    verbose("finding all open files...");
    my (%opened);
    open P4OPENED, "p4 opened |" || die "Bad can not run p4 opened.";
    while (defined(my $line = <P4OPENED>)) {
	my ($file, $unused) = ($line =~ m,^(//.+)#\d+ - .*,);
	die "Bad p4 opened line: $line" if (! defined($file));
	verbose("file = $file");
        my $local = findLocal($file);
	$opened{$local} = 1;
    }
    close P4OPENED;

    # TODO: filter unmodified files

    verbose("saving all open files...");
    foreach my $file (sort(keys(%opened))) {
        my $out = "$dirOut/$file";
        verbose("copy $file to $out");
        my $dir = dirname($out);
        (-d $dir) || mkpath($dir) || die "can not mkpath: $dir";
        copy($file, "$dirOut/$file") || die "can not copy: $file";
    }

    return 0;
}


#----------
# mainline
#----------

readP4Set();
setOptions();
findRoot();

my $err = doSave();
printf("$PROG: %s\n", ($err ? "Failed" : "Succeeded"));

exit $err;