#!/usr/bin/perl -w

# Copyright (c) 2015, 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 produce a 'resgen' compatible via file of the resources that
# would be exported by a C modules during the 'resources' phase, useful to
# allow the module to have a RAM loading 'standalone' variant too.

use strict;

my $posix = -e '.';
my $verbose = 0;
my $localdir;
my $resfsdir;
my $viafile;

sub usage
{
	die(<<EOF);
Usage: $0 [-h] [-v] <local dir> <ResourceFS dir> <viafile>
-h               Print this help.
-v               Verbose.
<local dir>      Directory where the files reside.
                 This must use the system's native filesystem syntax.
<ResourceFS dir> Target directory in ResourceFS.
                 This should be in RISC OS format - directory separator is '.'
<viafile>        Where to write the result.                 
                 This must use the system's native filesystem syntax.
EOF
}

sub scandir
{
	my $src = $_[0];
	my $dst = $_[1];
	my $srcpath;
	my $dstpath;
	my $sep = $posix ? '/' : '.';
	my $leafname;
	my $baselen = length($_[2]);
	my $via = $_[3];
	local (*DIR);

	# Catalogue the candidate directory
	opendir(DIR, $src) or die $!;
	while ($leafname = readdir(DIR))
	{
		# Hide '.' names on Posix
		next if ($leafname =~ m/^\./);
		$srcpath = $src . $sep . $leafname;
		$dstpath = $dst . substr($srcpath, $baselen);
		if ($posix)
		{
			# Viafile expects destinations in RISC OS format
			$dstpath =~ s/\//./g;
			$dstpath =~ s/,[0-9a-f]{3}$//;
		}
		if (-f $srcpath)
		{
			# It's a file, append to the via file
			open(VIA, ">>$via") or die $!;
			print VIA "$srcpath $dstpath\n";
			close(VIA);
		}
		else
		{
			# The wobbly Perl 5.001 (distributed by ROOL) seems to explode
			# all to easily when recursing even if just moving args about
			scandir($srcpath, $_[1], $_[2], $_[3]);
		}
	}
	closedir(DIR);
}

# Parse the command line

usage() unless (@ARGV);

while (1)
{
	$_ = $ARGV[0];
	last if /^[^-]/;
	shift;
	# -h or --help
	usage() if (/^-h$/ || /^--help$/);
	# -v
	$verbose += /^-v$/;
}
usage() unless (@ARGV);
$localdir = shift;
usage() unless (@ARGV);
$resfsdir = shift;
usage() unless (@ARGV);
$viafile = shift;

# Output a via file relating candidate leafnames to ResourceFS paths

print "Scan $localdir for files to put in $resfsdir\n" if $verbose;
unlink($viafile);
scandir($localdir, $resfsdir, $localdir, $viafile);
exit(0);
