#!/usr/bin/perl -w

# Copyright (c) 2010, RISC OS Open Ltd
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met: 
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * 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.
#     * Neither the name of RISC OS Open Ltd nor the names of its contributors
#       may be used to endorse or promote products derived from this software
#       without specific prior written permission.
#
# 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS 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.

# Script to allow components' install and resources phases to be written in a
# platform-independent manner. Target Perl installations are the RISC OS port
# of Perl 5.001 (distributed by ROOL), and any Perl which internally uses
# Posix-style filespecs - this includes Cygwin, Linux and Mac OS X versions
# of Perl, as well as later RISC OS ports based on UnixLib. RISC OS Perl
# 5.001 is unable to load most of the standard Perl modules so we have to do
# most of the heavy lifting within this script.

use strict;

sub usage
{
	die(<<EOF);
Usage: $0 [-h] [-v] [-I <includepath>] <destroot> <filespec> [...]
-h               Print this help.
-v               Verbose.
-I <includepath> Comma-separated list of prefixes to apply to source filename.
                 These should be in RISC OS format - directory separator is '.'
<destroot>       Path to destination directory to hold installed files.
                 This must use the system's native filesystem syntax.
                 All necessary subdirectories are created automatically.
<filespec>       One or more words of the format <source>[:<destpath>]
                 each of which may optionally be enclosed in square brackets
                 to indicate that it is not an error if the source file cannot
                 be found on the include path
<source>         Path to source file, relative to one of the directories on
                 the include path. Do not include any ',xxx' filetype suffix.
                 May include RISC OS-style '.' separators to refer to files in
                 subdirectories of those on the include path, but only the
                 leafname is used when constructing the destination filename.
<destpath>       Optional subdirectory of destination directory in which to
                 place this file. May use RISC OS '.' directory separators if
                 the file should be nested more than one level deep.
EOF
}

my $posix = -e '.';
my $verbose = 0;
my @includepath;
my $destroot;
my @filespec;

# Parse the command line

usage unless (@ARGV);
while (1)
{
	$_ = $ARGV[0];
	last if /^[^-]/;
	shift;
	# -h or --help
	usage if (/^-h$/ || /^--help$/);
	# -v
	$verbose += /^-v$/;
	# -I
	if (/^-I$/)
	{
		usage unless (@ARGV);
		push(@includepath, split /,/, shift);
	}
}
usage unless (@ARGV);
$destroot = shift;
usage unless (@ARGV);
while ($_ = shift)
{
	my %file;
	$file{optional} = s/^\[(.*)\]$/$1/;
	($file{source},$file{destpath}) = (split (/:/),"");
	push(@filespec,\%file);
}

if ($verbose >= 2)
{
	print "Parsed command line as follows:\n";
	print "\tincludepath: @includepath\n";
	print "\tdestroot: $destroot\n";
	my $file;
	foreach $file (@filespec)
	{
		my @details = %$file;
		print "\tfilespec: @details\n";
	}
}

# Loop over the source files and over the include paths for each one

my $sep = $posix ? '/' : '.';
my $sep_pat = $posix ? '/' : '[.]';
my $file;
foreach $file (@filespec)
{
	my ($path,$typedleaf,$include);
	foreach $include (@includepath, "")
	{
		# Restructure include path + relative path into path + leaf
		# The first step will create a leading . if no include path
		# but that's actually helpful in the split statement
		$_ = join('.', $include, $$file{source});
		($path, my $leaf) = split /([^.]*$)/;
		$path =~ s/^\.?(.*)\.$/$1/; # lose trailing and any leading .
		$path =~ tr\./\/.\ if $posix;
		$leaf =~ tr\./\/.\ if $posix;
		$path || ($path = $posix ? '.' : '@'); # handle no-dir case
		print "Looking for $leaf in $path\n" if ($verbose >= 2);
		next unless -d $path; # RISC OS perl doesn't complain below!
		opendir(*dh, $path) || next;
		my @matches = grep {/^$leaf(|,lxa|,[\da-f]{3})$/} readdir(*dh);
		closedir(*dh);
		print "Matches: ",scalar @matches," (@matches)\n" if ($verbose >= 2);
		if (@matches)
		{
			print "Warning: multiple matches for $$file{source}, using $matches[0]\n" if $matches[1];
			unless (-f $path.$sep.$matches[0])
			{
				print "Warning: $$file{source} is a directory, skipping\n";
				next;
			}
			$typedleaf = $matches[0];
			last;
		}
	}
	if ($typedleaf)
	{
		# Found a match
		# Recursively create subdirectories at destination
		$$file{destpath} =~ tr\./\/.\ if $posix;
		@_ = split(/$sep_pat/, $$file{destpath});
		my $destpath = $destroot;
		my $dir;
		foreach $dir (@_)
		{
			$destpath .= $sep.$dir;
			print "Create dir $destpath\n" if $verbose;
			mkdir $destpath, 0755 || die $!;
		}
		# Construct destination filename
		$destpath .= $sep.$typedleaf;
		# Do the copy
		print "Copy $path$sep$typedleaf to $destpath\n" if $verbose;
		if ($posix)
		{
			require File::Copy; # can't use use, won't compile on RISC OS
			File::Copy::copy($path.$sep.$typedleaf, $destpath) || die $!;
		}
		else
		{
			system("Copy $path$sep$typedleaf $destpath ~CF~N~R~V");
		}
	}
	else
	{
		# No match found
		die "No such file '$$file{source}'\n" unless $$file{optional};
		print "Ignoring missing file $$file{source}\n" if $verbose;
	}
}

