#!/usr/bin/perl
#require 5.008;
our $VERSION = "0.03"; #Time-stamp: <2012-02-11T08:59:40Z>

## License:
##
##   I in a provincial state made this program intended to be public-domain. 
##   But it might be better for you like me to treat this program as such 
##   under the BSD-License or under the Artistic License.
##
##   Within three months after the release of this program, I
##   especially admit responsibility of effort for rational request of
##   correction to this program.
##
## Author's Link:
##
##   http://jrf.cocolog-nifty.com/software/
##   (The page is written in Japanese.)
##

use strict;
use warnings;
use utf8; # Japanese English

use Encode;
use File::Spec::Functions qw(catfile splitpath splitdir);
use File::Copy;
use File::stat;

#our $FILENAME_ENCODER = Encode::find_encoding('cp932') or die;
our $FILENAME_ENCODER = Encode::find_encoding('utf8') or die;
#our $CONSOLE_ENCODER = Encode::find_encoding('cp932') or die;
our $CONSOLE_ENCODER = Encode::find_encoding('utf8') or die;

use Getopt::Long;

our $DEST;
our $PREFIX;

our $DEBUG = 0;
our $OVERWRITE = 0;
our $VERBOSE = 1;
our $FLATTEN = 0;

#Getopt::Long::Configure("bundling", "no_ignore_case", "auto_version");
Getopt::Long::Configure("no_ignore_case", "auto_version");
GetOptions(
	   "verbose|V" => sub { $VERBOSE = 2; },
	   "q" => sub { $VERBOSE = 0; },
	   "debug|d:1" => \$DEBUG,
	   "F" => \$FLATTEN,
	   "f" => \$OVERWRITE,
	   "prefix|P=s" => \$PREFIX,
	   "target-directory|t=s" => \$DEST,
	   "help|h" => sub { usage(0); },
	  );

sub usage {
  my ($ext) = @_ || 0;
  print <<"EOU";
Usage: $0 -q --prefix=PREFIX FILES DIR
   or: find -name '*' -print0 | xargs -0 $0 -q -F -t DIR

OPTIONS:
  --prefix=PREFIX	specify the prefix.
  -f			force overwrite when the file exists.
			(default: skip with warning.)
  -F			flatten directories of each filename with "_".
  -t DIR		specify the target directory.
  --verbose		report verbosely.
  -q			quiet. no warnings.
  -d			debug mode. no copy.
EOU
  exit($ext);
}

if (! defined $DEST) {
  if (@ARGV < 2 || ! defined $PREFIX) {
    usage(1);
  }
  $DEST = pop(@ARGV);
} else {
  if (! defined $PREFIX) {
    $PREFIX = "";
  }
}

if (! -d $DEST) {
  die "$DEST is not a directory, or doesn't exist.\n";
}


sub pcopy {
  my ($src, $dest) = @_;
  my $stat = stat($src);
  copy($src, $dest) or return 0;
  return utime($stat->atime, $stat->mtime, $dest);
}

MAIN: {
#  print "files = " . @ARGV . "\n";
  while (@ARGV) {
    my $f = $CONSOLE_ENCODER->decode(shift(@ARGV));
    next if $f eq "." || $f eq "..";
    my ($v, $d, $base) = splitpath($f);
    if ($FLATTEN) {
      my @dir = splitdir($d);
      @dir = grep { $_ ne "" && $_ ne "." && $_ ne ".."} @dir;
      $d = join("_", @dir);
      $d .= "_" if $d ne "";
    } else {
      $d = "";
    }
    my $dest = catfile($DEST, $PREFIX . $d . $base);
    if (-f $FILENAME_ENCODER->encode($dest) && ! $OVERWRITE) {
      print $CONSOLE_ENCODER->encode("(skip) $dest is already exists.\n")
	if $VERBOSE > 0;
    } else {
      if (-d $FILENAME_ENCODER->encode($f)) {
	if ($FLATTEN) {
	  print $CONSOLE_ENCODER->encode("(skip) $f is a directory.\n")
	    if $VERBOSE > 0;
	} else {
	  print $CONSOLE_ENCODER->encode("(skip) $f is a directory.\n")
	    if $VERBOSE > 0;
#	  print $CONSOLE_ENCODER->encode("make a directory: $dest\n") if $VERBOSE >= 2;
#	  if (! $DEBUG) {
#	    mkdir $FILENAME_ENCODER->encode($dest)
#	      or die $CONSOLE_ENCODER->("$dest: $!\n");
#	  }
	}
      } else {
	print $CONSOLE_ENCODER->encode("copy $f to $dest\n") if $VERBOSE >= 2;
	if (! $DEBUG) {
	  pcopy($FILENAME_ENCODER->encode($f),
		$FILENAME_ENCODER->encode($dest))
	    or die $CONSOLE_ENCODER->("$dest: $!\n");
	}
      }
    }
  }
}
