Recursive ‘Web Friendly’ File Renamer with Perl

By | Perl Scripts

For a work project I needed to fix the contents of a deep nested folder structure and make the files ‘web friendly’. For sake of argument web friendly in this context means:

  • No spaces (replaced with dashes)
  • No wacky punctuation defined by the regex = [!-,:-\@[-^`\/–]+
  • No starting or ending dashes or spaces

See what I came up with below:

THE CODE

# Recursive 'Web Friendly'
# File Renamer with Perl

#!/usr/bin/perl

########## PRAGMAS

use Term::ANSIColor 2.00 qw(:pushpop);
use strict;
use feature qw~say~; 
use Data::Dump qw~dump~;
use File::Copy;

########## GLOBALS

my $db    = {};
my $dir   = '.'; # Targets current directory                                                                
$|++;

########## INIT

scan_dir($dir);

########## SUBS

sub scan_dir ($)
{
	
	my $dir = shift;

	opendir ( my $fh, $dir ) 
		|| die "Error in opening dir $dir\n";

	while( (my $item = readdir($fh)) ) 
	{		
		next if $item =~ m`^\.`;

		my $dir_now = "$dir/$item";

		if (-d $dir_now)
		{
			scan_dir($dir_now); # Recursion
			
			my $new_name = rename_me($item); # Rename to 'web friendly'
			
			rename $dir_now, "$dir/${new_name}" 
				|| die ( "Error in renaming\n" );
				
			say "Renaming Directory: ", 
				PUSHCOLOR BRIGHT_GREEN "$item >> $new_name",
				RESET; # Remove color text
		}
		elsif (-f $dir_now)
		{
			my $new_name = rename_me($item);
			
			rename $dir_now, "$dir/${new_name}" 
				|| die ( "Error in renaming\n" );
				
			say "Renaming File: ", 
				PUSHCOLOR BRIGHT_YELLOW "$item >> $new_name",
				RESET;	
		}
	}
	closedir($fh);
}

sub rename_me ($)
{
	my $item = shift;
	
	my $match;
	
	$item =~ s`(?x)
	
	(?:
		^([\ _-])+
		|
		(?1)+$
	)
	(?{ $match = q~~ })
	|
	(?1)+				
	(?{ $match = q~-~ })
	|
	(?: [!-,:-\@\[-^\`\/–]+ )	
	(?{ $match = q~~ })	
	
	`$match`ge;
	
	$item = "\u${item}\E";
	
	return $item;
}

__END__

One Response to " Recursive ‘Web Friendly’ File Renamer with Perl "

Leave a Reply

Your email address will not be published. Required fields are marked *