#! /usr/bin/perl
# vim: set filetype=perl:

# uppercase: rename files to all uppercase filenames

# Copyright (C) 2005-2020 by Brian Lindholm.  This file is part of the
# littleutils utility set.
#
# The uppercase utility is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later version.
#
# The uppercase utility is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along with
# the littleutils.  If not, see <https://www.gnu.org/licenses/>.

# specify modules
use strict;
use warnings;
use Fcntl;
use Getopt::Std;
use locale;

# get input arguments
our $opt_h = ''; our $opt_q = ''; our $opt_v = ''; our $opt_x = ''; our $opt_X = '';
my $good_opt = getopts('hqvxX');

# print help if requested or if bad options used, then quit
if (not ($good_opt) or ($opt_h) or ($#ARGV < 0)) {
  print "uppercase 1.2.3\n";
  print "usage: uppercase [-h(elp)] [-q(uiet)] [-v(erbose)]\n";
  print "         [-x(tension_only)] [-X(tensions_only)] file...\n";
  exit ($good_opt eq '');
}

# determine if we're running under DOS or Windows
my $dos_win = (($^O eq 'dos') or ($^O eq 'MSWin32') or ($^O eq 'cygwin'));

# run through list of files
my %path_writeable = ();
LOOP: foreach my $old_name (@ARGV) {
  # clean up filename
  $old_name =~ s://+:/:;     # collapse multiple "/"
  $old_name =~ s:^(\./)+::;  # remove leading "./"
  $old_name =~ s:/$::;       # remove trailing "/"
  # skip certain cases
  next LOOP if (($old_name eq '.') || ($old_name eq '..'));
  # split into path and filename
  my $path = ''; my $name = '';
  if ($old_name =~ /^(.*)\/(.+?)$/) {
    $path = $1;
    $name = $2;
  }
  else {
    $path = '.';
    $name = $old_name;
  }
  # determine if path is writeable
  if (not defined($path_writeable{$path})) {
    $path_writeable{$path} = (-w $path);
  }
  if (not $path_writeable{$path}) {
    print STDERR "pren warning: you don't have write permissions in $path\n";
    next LOOP;
  }
  # split into base and filename if requested
  my $base = ''; my $ext = ''; my $trying = 0;
  if ($opt_x) {
    if ($name =~ /^(.+)\.([^.]+)$/) {
      $base = $1;
      $ext = $2;
      $trying = 1;
    }
    else {
      $base = $name;
      $ext = '';
      $trying = 0;
    }
  }
  elsif ($opt_X) {
    if ($name =~ /^(.*?)\.(.+)$/) {
      $base = $1;
      $ext = $2;
      $trying = 1;
    }
    else {
      $base = $name;
      $ext = '';
      $trying = 0;
    }
  }
  # convert to uppercase
  my $new_name = '';
  if ($path eq '.') {
    if (($opt_x || $opt_X) && $trying) {
      $new_name = $base . '.' . uc($ext);
    }
    else {
      $new_name = uc($name);
    }
  }
  else {
    if (($opt_x || $opt_X) && $trying) {
      $new_name = $path . '/' . $base . '.' . uc($ext);
    }
    else {
      $new_name = $path . '/' . uc($name);
    }
  }
  # determine if rename should actually happen
  if (($opt_x || $opt_X) && (not $trying)) {
    if ($opt_v) {
      print STDOUT "uppercase message: skipping $old_name\n";
    }
  }
  elsif ($new_name eq $old_name) {
    if ($opt_v) {
      print STDOUT "uppercase message: $old_name already uppercase\n";
    }
  }
  elsif ((not $dos_win) && (-e $new_name)) {
    print STDERR "uppercase warning: new name for $old_name already exists\n";
  }
  else {
    if ((not $dos_win) && (-f $old_name)) {
      # the sysopen is for security in world-writeable directories
      sysopen(HANDLE, $new_name, O_RDWR | O_CREAT | O_EXCL, 0600)
        or die "uppercase ERROR: possible SYMLINK ATTACK!!\n";
      close(HANDLE);
    }
    rename($old_name, $new_name)
      or die "uppercase ERROR: move from $old_name to $new_name FAILED!!\n";
    if (not $opt_q) {
      print STDOUT "$old_name moved to $new_name\n";
    }
  }
}
