#!/usr/bin/env perl
#
# $Id: //guest/daniel_kionka/save-opened/save-opened.pl#6 $
#
# 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 $dirParentDefault = "$tmpdir/save-opened";

# for config file
my %configOpts;

# command line options
my $flagTarball;
my $verbose = 0;
my ($dirParent, $dirBase, $dirOut);

# info from p4
my $p4Root;

#-----------------------------
# low-level utility functions
#-----------------------------

#
# returns a string similar to the yyyy/mm/dd:hh:mm:ss format, but with "-"s
#
sub dateString()
{
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
    $year += 1900;
    $mon++;
    return sprintf("%04d-%02d-%02d-%02d-%02d-%02d",
        $year, $mon, $mday, $hour, $min, $sec);
}

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

#-------------------------------
# command line option 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 [-htv] [-b basename] [-c client] [-d parent-directory]

-b base   : basename of output directory or tarball
-c client : override P4CLIENT
-d parent : parent directory where snapshots are saved
-h        : this (help) message
-t        : create a tar archive
-v        : verbose output

EOF
    exit 1;
}

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

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

    # verify p4 environment 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
    $flagTarball = $opt{t};
    $verbose = $opt{v};
    $dirParent = (defined($opt{d}) ? $opt{d} : $dirParentDefault);
    $dirBase = (defined($opt{b}) ? $opt{b} : "$ENV{P4CLIENT}-" . dateString());
    $dirOut = "$dirParent/$dirBase";
}

#------------------------
# p4 dependent functions
#------------------------

#
# read values from p4 set as defaults before reading command line options
#
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) || die "Can not 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;
}

#----------------------
# high-level functions
#----------------------

#
# 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

    # TODO: add non-checked out modified 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";
    }

    if ($flagTarball) {
        verbose("creating tarball...");
        my $tarballBase = basename($dirOut) . ".tar";
        # do not leave previous one in case we fail
        unlink("$dirParent/$tarballBase");
        if (-d $dirOut) {
            chdir($dirOut) || die "Can not chdir: $dirOut";
            # use relative path because Cygwin tar has a different /tmp
            my $tarball = "../$tarballBase";
            system("tar cf \"$tarball\" .");
            die "Can not write: $tarball" if (! -s $tarball);
            # TODO: verify contents?
            chdir($dirParent) || die "Can not chdir: $dirParent";
            rmtree($dirOut) || die;
        }
        else {
            die "output directory not created: $dirOut" if (! keys(%opened));
        }
    }

    return 0;
}


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

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

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

exit $err;