Cacher is the code snippet organizer for pro developers

# created by Austin Dixon 6/12/2013

# checks directory for bad filenames

#! usr/local/bin/perl
use Tkx;
use LWP::Simple;

# SETUP
													
# frame objects
my $fa;
# label objects
my $la;
my $lb;
# button objects
my $ba;
my $bb;

#-------------------------------------------------
# convert button sub routine

sub chooseFile {
$dir = Tkx::tk___chooseDirectory();
$bb->configure( -state => 'active');
} 

#--------------------------------------------------
# file convert sub routine

sub runSub {

#----------
# open directory and parse (2 levels down)
opendir(DIR, $dir) or die "can't open $dir\n";
while ($file = readdir(DIR)){
	if ($file =~ /^\./){next;}  # skip dot files
	$path = $dir. "\\" . $file;
 
	if (-d $path){
    push (@dirs, $file);
	
	opendir(DIR_2, $path) or die "can't open $dir\n";
	while ($file_2 = readdir(DIR_2)){
		if ($file_2 =~ /^\./){next;}  # skip dot files
		$path_2 = $path. "\\" . $file_2;
		
			if (-d $path_2){
				push (@subdirs, $file_2);
				
				opendir(DIR_3, $path_2) or die "can't open $dir\n";
				while ($file_3 = readdir(DIR_3)){
					if ($file_3 =~ /^\./){next;}  # skip dot files
					push (@files, $file_3);
						if (!($file_3 =~ /^[a-z]{1}\d{4}\_\d{7}\_\d{7}(\_\d{4}(\_\d{3})?)?\.[\w]{2,4}$/)){
						push (@badnames, $file_3);
						}
				}
			}
		
	
	
		else {
		push (@files, $file_2);
		if (!($file_2 =~ /^[a-z]{1}\d{4}\_\d{7}\_\d{7}(\_\d{4}(\_\d{3})?)?\.[\w]{2,4}$/)){
			push (@badnames, $file_2);
			}
		}
		}
	}	
    
	
	else {
	push (@files, $file);
		if (!($file =~ /^[a-z]{1}\d{4}\_\d{7}\_\d{7}(\_\d{4}(\_\d{3})?)?\.[\w]{2,4}$/)){
		push (@badnames, $file);
		}
	}
close(DIR);
close(DIR_2);
close(DIR_3);
}

#----------
# examine baddirs
$num = 0;
while ($num < @dirs){
	if (!(@dirs[$num] =~ /^[a-z]{1}\d{4}\_\d{7}\_\d{7}(\_\d{4}(\_\d{3})?)?$/)){
		push (@baddirs, @dirs[$num]);
		$num ++;
		}
	$num ++;
	}

#----------
# examine badnames
$num = 0;
while ($num < @badnames){
	if (!(@badnames[$num] =~ /^[a-z]{1}\d{4}\.*/)){
		push (@bad_group, @badnames[$num]);
		$num ++;
		}
	elsif (!(@badnames[$num] =~ /^[a-z]{1}\d{4}\_\d{7}\.*/)){
		push (@bad_collection, @badnames[$num]);
		$num ++;
		}
	elsif (!(@badnames[$num] =~ /^[a-z]{1}\d{4}\_\d{7}\_\d{7}\.*/)){
		push (@bad_item, @badnames[$num]);
		$num ++;
		}	
	elsif (!(@badnames[$num] =~ /^[a-z]{1}\d{4}\_\d{7}\_\d{7}\_\d{4}\_\d{3}\.*/)){
		push (@bad_page, @badnames[$num]);
		$num ++;
		}	
	elsif (!(@badnames[$num] =~ /^.*[\w]{2,4}/)){
		push (@bad_extension, @badnames[$num]);
		$num ++;
		}	
	$num ++;
	}

#----------
# if none found
$none = "None Found";
if (@badnames == 0){
	push (@badnames, $none)
}
if (@baddirs == 0){
	push (@baddirs, $none)
}

#----------
# sort
@sorted_dirs = sort { lc($a) cmp lc($b) } @dirs;
@sorted_subdirs = sort { lc($a) cmp lc($b) } @subdirs;
@sorted_files = sort {$a <=> $b;} @files;
@sorted_badnames = sort {$a <=> $b;} @badnames;
@sorted_baddirs = sort { lc($a) cmp lc($b) } @baddirs;

@sorted_group = sort {$a <=> $b;} @bad_group;
@sorted_collection = sort {$a <=> $b;} @bad_collection;
@sorted_item = sort {$a <=> $b;} @bad_item;
@sorted_page = sort {$a <=> $b;} @bad_page;
@sorted_extension = sort {$a <=> $b;} @bad_extension;
@sorted_underscore = sort {$a <=> $b;} @bad_underscore;

#----------
# print results
open (MYFILE, ">output.txt");
print MYFILE "I found: \n\n";
$count = scalar @dirs;
print MYFILE "$count directories \n";
$count = scalar @subdirs;
print MYFILE "$count sub-directories \n";
$count = scalar @files;
print MYFILE "$count files \n";
	
$num = 0;
$count = scalar @badnames;
print MYFILE "\n---------------------------------------------- \n\n";
print MYFILE "The following $count files are named incorrectly: \n\n";
while ($num < @sorted_badnames){	
	print MYFILE "@sorted_badnames[$num] \n";
	$num ++;
	}
	
$num = 0;
$count = scalar @baddirs;
print MYFILE "\n---------------------------------------------- \n\n";
print MYFILE "The following $count directories are named incorrectly: \n\n";
while ($num < @sorted_baddirs){	
	print MYFILE "@sorted_baddirs[$num] \n";
	$num ++;
	}

$num = 0;
print MYFILE "\n\n\n***************************************************************************** \n";
print MYFILE "***************************************************************************** \n\n\n";
print MYFILE "The following items have a bad holding group: \n\n";
while ($num < @sorted_group){	
	print MYFILE "@sorted_group[$num] \n";
	$num ++;
	}
	
$num = 0;
print MYFILE "\n---------------------------------------------- \n\n";
print MYFILE "The following items have a bad collection number: \n\n";
while ($num < @sorted_collection){	
	print MYFILE "@sorted_collection[$num] \n";
	$num ++;
	}

$num = 0;
print MYFILE "\n---------------------------------------------- \n\n";
print MYFILE "The following items have a bad item number: \n\n";
while ($num < @sorted_item){	
	print MYFILE "@sorted_item[$num] \n";
	$num ++;
	}
	
$num = 0;
print MYFILE "\n---------------------------------------------- \n\n";
print MYFILE "The following items have a bad page number: \n\n";
while ($num < @sorted_page){	
	print MYFILE "@sorted_page[$num] \n";
	$num ++;
	}

$num = 0;
print MYFILE "\n---------------------------------------------- \n\n";
print MYFILE "The following items have a bad file extension: \n\n";
while ($num < @sorted_extension){	
	print MYFILE "@sorted_extension[$num] \n";
	$num ++;
	}
	
close (MYFILE); 

}

#---------------------------------------------------
# GUI elements

# main window
my $mw = Tkx::widget->new(".");
$mw->g_wm_title("Bad Name Checker");
$mw->g_wm_minsize(200, 130);

# frame a
$fa = $mw->new_frame(
-relief => 'solid',
-borderwidth => 1,
-background => 'light gray',
);
$fa->g_pack( -side => 'left', -fill => 'both' );

#---------------------------------------------------
# choose file

$la = $fa->new_label(
-text => '       Choose Directory to Scan:       ',
-font => 'bold',
-bg => 'light gray',
-foreground => 'black',
);
$la->g_pack( -side => 'top', -fill => 'both' );

$lb = $fa->new_label(
-bg => 'blue',
-foreground => 'cyan',
-width => 30,
-textvariable => \$dir,
);
$lb->g_pack( -side => 'top' );

$ba = $fa->new_button(
-text => 'Choose',
-command => \&chooseFile,
-height => 1,
-width => 15,
);
$ba->g_pack( -side => 'top', -pady => 5 );

#---------------------------------------------------
# convert button

$bb = $fa->new_button(
-borderwidth => 1,
-text => 'RUN',
-font => 'bold',
-command => \&runSub,
-state => 'disabled',
-height => 2,
-width => 15,
);
$bb->g_pack( -side => 'bottom', -pady => 10 );

#---------------------------------------------------

Tkx::MainLoop();