The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package App::FileTools::BulkRename::UserCommands;
# ABSTRACT: User namespace routines.
use strict;
use warnings;

BEGIN
  { our $VERSION = substr '$$Version: 0.07 $$', 11, -3; }

use Clipboard;
use Contextual::Return;
use File::Slurp;

use App::FileTools::BulkRename::Common qw(modifiable);
use App::FileTools::BulkRename::UserCommands::AutoFormat qw(afmt);

# We're overriding the core uc and lc routines to provide versions
# that automatically modify their parameters if called in void
# context.

# In practice this shouldn't be an issue, as uc and lc throw errors in
# void context, which is the only context in which these two subs are
# supposed to differ, but better safe than sorry.

package _USER;
use subs qw(uc lc);  # override the core routines.
package App::FileTools::BulkRename::UserCommands;

sub _USER::uc{ return afmt('upper',     @_); }
sub _USER::lc{ return afmt('lower',     @_); }

sub _USER::sc{ return afmt('sentence',  @_); }
sub _USER::tc{ return afmt('title',     @_); }
sub _USER::hc{ return afmt('highlight', @_); }

#
# These should be converted so they can take either scalars or lists
# and do the right thing...
#

sub _USER::spc
  { my $str  = $_[0] // $_;
    my $chrs = $_[1] // '._';
    my $pat=qr([\Q$chrs\E]);

    $str		     =~ s/$pat/ /g;
    if( VOID )
      { modifiable($_[0],$_) =	$str; return; }
    else
      { return $str; }
  }

sub _USER::slurp
  { my $fil = $_[0] // $_;

    if( VOID )
      { my $s = read_file($fil);

	utf8::decode($s);
	utf8::decode($s);
	return modifiable($_[0], $_) = $s;
      }
    if( SCALAR )
      { my $s = read_file($fil);

	utf8::decode($s);
	utf8::decode($s);
	return $s;
      }
    if( LIST )
      { my @dat = read_file($fil);
	my @ret;
	foreach my $line (@dat)
	  {
	    chomp $line;
	    utf8::decode($line);
	    utf8::decode($line);
	    push @ret,$line;
	  }
      }
  }

sub _USER::clip
  { my $out = Clipboard::paste();
    # no idea why I need to do this TWICE!
    utf8::decode($out);
    utf8::decode($out);

    if( VOID )
      { $_ = $out }
    if( SCALAR )
      { return $out }
    if( LIST )
      { return split("\n",$out); }
  }


# sub clip
#   { my $pat  = shift;
#     my $clip = Clipboard::paste();

#     if( SCALAR )
#       {
# 	return $clip unless defined $pat;
# 	my @list = ($clip =~ m($pat)mg);
# 	return join '',@list;
#       }

#     if( LIST )

# 	if( defined $pat )
#       {
# 	my @list = ($out =~ m($pat)mg);
# 	my $cap	 = $#+;

# 	print Dumper(\$pat,\$out,\@list,\$cap);
# 	exit -1;
#       }

#     # SCALARREF and ARRAYREF are autogenerated, so we don't
#     # bother defining them.
#     return
#       (
# 	::SCALAR  { $out		}
# 	::LIST    { split("\n",$out)	}
# 	::HASHREF { {}			}
#       );
#   }

use Data::Dumper;

sub _USER::rd
  { my @dirs = @_;

    push @dirs,$_ if !@dirs && defined($_);
    push @dirs,"." if !@dirs;

    my @ret;
    for my $dir (@dirs)
      {
	for my $ent (sort(read_dir($dir)))
	  {
	    utf8::decode($ent);
	    utf8::decode($ent);
	    push @ret, $ent;
	  }
      }

    if( VOID )
      { return modifiable($_[0], $_) = join("\n",@ret)."\n"; }
    if( SCALAR )
      { return join("\n",@ret)."\n"; }
    if( LIST )
      { return @ret; }
  }

1;