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;