#!/p4/common/perl/bin/perl

#------------------------------------------------------------------------------
# Copyright 2016 (c) Perforce Software, Inc.  All rights reserved
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# 
# 1  Redistributions of source code must retain the above copyright
#   notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE
# SOFTWARE, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR 
# TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF 
# THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
# DAMAGE.
#------------------------------------------------------------------------------

# This script is installed as an archive trigger on the Perforce
# server.

# An example of its behavior once installed:
# echo $(date) | unix2dos > file

# file file
# file: ASCII text, with CRLF line terminators

# p4 add file
# p4 submit -d file

# p4 retype -l -t +X file
# //depot/file#1 - text now text+X

# p4 -v lbr.verify.out=0 sync -f file
# //depot/file#1 - refreshing /ram/le/c/file

# file file
# file: ASCII text

#------------------------------------------------------------------------------

use 5.014;
use strict;
use autodie;
use IO::File;
use File::Spec;
use File::Path 'make_path';
use warnings FATAL => 'all';

# todo: %triggerMeta_depotFile% ?

my $help = "USAGE:\n\nTriggers:\n\t"    .
           "LE_conv archive //... \"$0" .
           ' /tmp/conv %op% %rev% %quote%%file%%quote%"';

die "$help\n" unless @ARGV == 4;

my ( $root, $op, $rev, $lbr ) = @ARGV;

sub ERR { die "$0 line ${\ caller }, '$root', $op, $rev, '$lbr': @_" }

my ( $volume, $dir, $file ) = File::Spec->splitpath( $lbr );

my $lbr_dir = File::Spec->catdir( $root, $dir );

make_path $lbr_dir, { error => \ my $err } unless -d $lbr_dir;

$err = join "\n",  map { join ': ', %$_ } @$err;

# Parallel runs can cause the leading parts of the dir to get created
# at the same time causing a 'File exists' error.
ERR " make_path '$lbr_dir': $!, '$err'" if $err && $err !~ /File exists/;

binmode STDOUT;
binmode STDIN;

my $lbr_file = File::Spec->catfile( $lbr_dir, "$file.$rev" );

my $lbr_fh = IO::File->new( $lbr_file, O_CREAT|O_RDWR, ':raw' )
  or ERR "$lbr_file: $!";

goto uc $op;

WRITE:

chmod 0600, $lbr_file;
print $lbr_fh s/\R/\012/gr for <STDIN>;

exit;

READ:

print for <$lbr_fh>;

exit;

DELETE:

exit;