"Fossies" - the Fresh Open Source Software Archive 
"Fossies" - the Fresh Open Source Software Archive A hint: This file contains one or more very long lines, so maybe it is better readable using the pure text view mode that shows the contents as wrapped lines within the browser window.
1 use strict; 2 use warnings; 3 4 #-------------------------------------------------------------------------------------------------------------- 5 # fixname 6 #-------------------------------------------------------------------------------------------------------------- 7 8 sub fixname 9 { 10 if($main::STOP == 1) 11 { 12 return 0; 13 } 14 15 if($main::CLI) 16 { 17 18 } 19 20 &plog(3, "sub fixname"); 21 22 # ----------------------------------------- 23 # Vars 24 # ----------------------------------------- 25 26 my $file = shift; 27 if(!$file) { return; } # prevent null entrys being processed 28 &plog(3, "sub fixname: processing \"$file\""); 29 30 $main::id3_writeme = 0; 31 my $newfile = $file; 32 my $tmpr = 1; 33 my @tmp_arr; 34 35 my $tag = 0; 36 my $art = ""; 37 my $tit = ""; 38 my $tra = ""; 39 my $alb = ""; 40 my $gen = ""; 41 my $year = ""; 42 my $com = ""; 43 my $newart = ""; 44 my $newtit = ""; 45 my $newtra = ""; 46 my $newalb = ""; 47 my $newgen = ""; 48 my $newyear = ""; 49 my $newcom = ""; 50 51 my $tmp = ""; 52 my $t_s = ""; 53 my $tl = 0; 54 my $file_ext_length = 0; 55 my $trunc_char_length = 0; 56 my $l = 0; 57 my $enum_n = 0; 58 my $file_ext = ""; 59 my $tmpfile = ""; 60 61 $main::cwd = cwd; # RM - legacy code ??? 62 63 if($main::id3_mode && !-f $file) 64 { 65 &plog(0, "sub fixname: \"$file\" does not exist"); 66 &plog(0, "sub fixname: current directory = \"$main::dir\""); 67 } 68 69 # ----------------------------------------- 70 # make sure file is allowed to be renamed 71 # ----------------------------------------- 72 73 if((!-d $file) && ($main::ig_type || $file =~ /\.($main::file_ext_2_proc)$/i)) 74 { 75 &plog(4, "sub fixname: \"$file\" passed file extionsion check"); 76 $tmpr = 0; 77 } 78 79 if($main::proc_dirs && -d $file) 80 { 81 &plog(4, "sub fixname: \"$file\" passed dir check, is a directory, dir mode is enabled"); 82 $tmpr = 0; 83 } 84 85 if($main::proc_dirs && $main::ig_type) 86 { 87 &plog(4, "sub fixname: \"$file\" being passed regardless, we are processing all file types"); 88 $tmpr = 0; 89 } 90 91 if($main::FILTER && &match_filter($file) == 0) 92 { 93 &plog(4, "sub fixname: \"$file\" didnt match filter"); 94 return; 95 } 96 if($tmpr == 1) 97 { 98 &plog(4, "sub fixname: rules say file shouldnt be renamed"); 99 return; 100 } 101 102 # recursive, print stuff 103 # this code inserts a line between directorys and prints the parent directory. 104 105 if 106 ( 107 $main::recr && 108 $main::last_recr_dir ne "$main::cwd" && # if pwd != last dir 109 $main::proc_dirs == 0 110 ) 111 { 112 &plog(4, "sub fixname: Printing dir in gui dirlist"); 113 $main::last_recr_dir = $main::cwd; 114 115 &nf_print(" ", "<MSG>"); 116 &nf_print($main::cwd, $main::cwd); 117 } 118 119 # Fetch mp3 tags, if file is a mp3 and id3 mode is enabled 120 # $tag will =1 only if tags r found & id3 mode is enabled 121 122 if($main::id3_mode & $file =~ /.*\.mp3$/) 123 { 124 &plog(4, "sub fixname: getting mp3 tags"); 125 @tmp_arr = &get_tags($file); 126 if($tmp_arr[0] eq "id3v1") 127 { 128 $tag = 1; 129 $newart = $art = $tmp_arr[1]; 130 $newtit = $tit = $tmp_arr[2]; 131 $newtra = $tra = $tmp_arr[3]; 132 $newalb = $alb = $tmp_arr[4]; 133 $newgen = $gen = $tmp_arr[5]; 134 $newyear = $year = $tmp_arr[6]; 135 $newcom = $com = $tmp_arr[7]; 136 } 137 138 # Do tag stuff now 139 140 $newart = &fn_replace($newart); 141 $newtit = &fn_replace($newtit); 142 $newalb = &fn_replace($newalb); 143 $newcom = &fn_replace($newcom); 144 145 $newart = &fn_spaces($newart); 146 $newtit = &fn_spaces($newtit); 147 $newalb = &fn_spaces($newalb); 148 $newcom = &fn_spaces($newcom); 149 150 $newart = &fn_case($newart); 151 $newtit = &fn_case($newtit); 152 $newalb = &fn_case($newalb); 153 $newcom = &fn_case($newcom); 154 155 $newart = &fn_sp_word($file, $newart); 156 $newtit = &fn_sp_word($file, $newtit); 157 $newalb = &fn_sp_word($file, $newalb); 158 $newcom = &fn_sp_word($file, $newcom); 159 160 $newart = &fn_case_fl($newart); 161 $newtit = &fn_case_fl($newtit); 162 $newalb = &fn_case_fl($newalb); 163 $newcom = &fn_case_fl($newcom); 164 165 $newart = &fn_post_clean($newart); 166 $newtit = &fn_post_clean($newtit); 167 $newalb = &fn_post_clean($newalb); 168 $newcom = &fn_post_clean($newcom); 169 } 170 171 $newfile = &run_fixname_subs($file, $newfile); 172 173 # guess id3 tags 174 if($main::id3_guess_tag == 1 && $_ =~ /.*\.mp3$/) 175 { 176 ($newart, $newtra, $newtit, $newalb) = &guess_tags($newfile); 177 } 178 179 # End of cleanups 180 181 #========================================================================================================================================== 182 # check for and apply filename/ id3 changes 183 #========================================================================================================================================== 184 185 &plog(4, "sub fixname: set user entered tags if any"); 186 187 if($main::id3_art_set && $file =~ /.*\.mp3$/i) 188 { 189 $newart = $main::id3_art_str; 190 $tag = 1; 191 } 192 193 if($main::id3_alb_set && $file =~ /.*\.mp3$/i) 194 { 195 $newalb = $main::id3_alb_str; 196 $tag = 1; 197 } 198 199 if($main::id3_gen_set && $file =~ /.*\.mp3$/i) 200 { 201 $newgen = $main::id3_gen_str; 202 $tag = 1; 203 } 204 205 if($main::id3_year_set && $file =~ /.*\.mp3$/i) 206 { 207 $newyear = $main::id3_year_str; 208 $tag = 1; 209 } 210 211 if($main::id3_com_set && $file =~ /.*\.mp3$/i) 212 { 213 $newcom = $main::id3_com_str; 214 $tag = 1; 215 } 216 217 if($main::id3v1_rm && $file =~ /.*\.mp3$/i) 218 { 219 if(!$main::testmode) 220 { 221 &rm_tags($file, "id3v1"); 222 } 223 else 224 { 225 $main::tags_rm++; 226 } 227 $tmp = "printme"; 228 } 229 230 # rm mp3 id3v2 tags 231 if($main::id3v2_rm && $_ =~ /.*\.mp3$/i) 232 { 233 if(!$main::testmode) 234 { 235 &rm_tags($file, "id3v2"); 236 } 237 else 238 { 239 $main::tags_rm++; 240 } 241 $tmp = "printme"; 242 } 243 244 # rm mp3 id3v1 tags 245 if($main::id3v1_rm && $main::id3v2_rm && $file =~ /.*\.mp3$/i) 246 { 247 $tag = 0; 248 } 249 250 if($tag == 0 && $file eq $newfile) 251 { 252 if($tmp eq "printme") 253 { 254 &nf_print($file, $newfile); 255 } 256 &plog(3, "sub fixname: no tags and no fn change, dont rename"); 257 return; 258 } 259 260 if($tag) 261 { 262 # fn & tags havent changed 263 264 if 265 ( 266 $main::id3_writeme == 0 && 267 $file eq $newfile && 268 $art eq $newart && 269 $tit eq $newtit && 270 $tra eq $newtra && 271 $alb eq $newalb && 272 $com eq $newcom && 273 $gen eq $newgen && 274 $year eq $newyear 275 ) 276 { 277 if($tmp eq "printme") 278 { 279 &nf_print($file, $newfile); 280 } 281 return; 282 } 283 284 if 285 ( 286 $main::id3_writeme == 1 || 287 $art ne $newart || 288 $tit ne $newtit || 289 $tra ne $newtra || 290 $alb ne $newalb || 291 $com ne $newcom || 292 $gen ne $newgen || 293 $year ne $newyear 294 ) 295 { 296 &plog(4, "sub fixname: one or more tags changed, write n bump counter"); 297 if(!$main::testmode) 298 { 299 &write_tags($file, $newart, $newtit, $newtra, $newalb, $newcom, $newgen, $newyear); 300 } 301 $main::id3_change++; 302 } 303 } 304 305 if($file ne $newfile) 306 { 307 if(!$main::testmode) 308 { 309 if(!&fn_rename($file, $newfile) ) 310 { 311 plog(0, "sub fixname: \"$newfile\" cannot preform rename, file allready exists"); 312 return 0; 313 } 314 } 315 else 316 { 317 # increment change for preview count 318 $main::change++; 319 } 320 } 321 322 &nf_print 323 ( 324 $file, 325 $newfile, 326 327 $art, 328 $tit, 329 $tra, 330 $alb, 331 $com, 332 $gen, 333 $year, 334 335 $newart, 336 $newtit, 337 $newtra, 338 $newalb, 339 $newcom, 340 $newgen, 341 $newyear 342 ); 343 }; 344 345 #========================================================================================================================================== 346 #========================================================================================================================================== 347 #========================================================================================================================================== 348 349 # returns 1 if succesfull rename, errors are printed to console 350 351 # this code looks messy but it does need to be laid out with the doubled up "if(-e $newfile && !$main::overwrite) " 352 # bloody fat32 returns positive when we dont want it, ie case correcting 353 354 sub fn_rename 355 { 356 if($main::STOP == 1) 357 { 358 return 0; 359 } 360 361 &plog(3, "sub fn_rename"); 362 my $file = shift; 363 my $newfile = shift; 364 my $tmpfile = $newfile."-FSFIX"; 365 366 &plog(4, "sub fn_rename: \"$file\" \"$newfile\""); 367 368 if($main::fat32fix) # work around case insensitive filesystem renaming problems 369 { 370 371 if( -e $tmpfile && !$main::overwrite) 372 { 373 $main::tmpfilefound++; 374 $main::tmpfilelist .= "$tmpfile\n"; 375 &plog(0, "sub fn_rename: \"$tmpfile\" <- tmpfilefound"); 376 return 0; 377 } 378 rename $file, $tmpfile; 379 if(-e $newfile && !$main::overwrite) 380 { 381 rename $tmpfile, $file; 382 &plog(0, "sub fn_rename: \"$newfile\" refusing to rename, file exists"); 383 return 0; 384 } 385 else 386 { 387 rename $tmpfile, $newfile; 388 &undo_add("$main::cwd/$file", "$main::cwd/$newfile"); 389 } 390 } 391 else 392 { 393 if(-e $newfile && !$main::overwrite) 394 { 395 $main::suggestF++; 396 &plog(0, "sub fn_rename: \"$newfile\" refusing to rename, file exists"); 397 return 0; 398 } 399 else 400 { 401 rename $file, $newfile; 402 &undo_add("$main::cwd/$file", "$main::cwd/$newfile"); 403 } 404 } 405 &plog(4, "sub fn_rename: \"$file\" to \"$newfile\" renamed."); 406 $main::change++; 407 return 1; 408 } 409 410 # this code has been segmented from the sub fixname in order for blockrename to take advantage 411 412 sub run_fixname_subs 413 { 414 my $file = shift; 415 my $newfile = shift; 416 417 &plog(3, "sub run_fixname_subs:"); 418 if(!$newfile) 419 { 420 &plog(4, "sub run_fixname_subs: processing \"$file\""); 421 } 422 else 423 { 424 &plog(4, "sub run_fixname_subs: processing \"$file\", \"$newfile\""); 425 } 426 427 # --------------------------------------- 428 # 1st Run, do before cleanup 429 # --------------------------------------- 430 431 $newfile = &fn_scene($newfile); # Scenify Season & Episode numbers 432 $newfile = &fn_unscene($newfile); # Unscene Season & Episode numbers 433 $newfile = &fn_kill_sp_patterns($newfile); # remove patterns 434 $newfile = &fn_kill_cwords($file, $newfile); # remove list of words 435 $newfile = &fn_replace($newfile); # remove user entered word (also replace if anything is specified) 436 $newfile = &fn_spaces($newfile); # convert underscores to spaces 437 $newfile = &fn_pad_dash($newfile); # pad - 438 $newfile = &fn_dot2space($file, $newfile); # Dots to spaces 439 $newfile = &fn_sp_char($newfile); # remove nasty characters 440 $newfile = &fn_rm_digits($newfile); # remove all digits 441 $newfile = &fn_digits($newfile); # remove digits from front of filename 442 $newfile = &fn_split_dddd($newfile); # split season episode numbers 443 444 $newfile = &fn_pre_clean($newfile); # Preliminary cleanup (just cleans up after 1st run) 445 446 # --------------------------------------- 447 # Main Clean - these routines expect a fairly clean string 448 # --------------------------------------- 449 450 $newfile = &fn_intr_char($newfile); # International Character translation 451 $newfile = &fn_case($newfile); # Apply casing 452 $newfile = &fn_pad_digits_w_zero($newfile); # Pad digits with 0 453 $newfile = &fn_pad_digits($newfile); # Pad NN w - , Pad digits with " - " 454 $newfile = &fn_sp_word($file, $newfile); # Specific word casing 455 456 $newfile = &fn_post_clean($file, $newfile); # Post General cleanup 457 458 # --------------------------------------- 459 # 2nd runs some routines need to be run before & after cleanup in order to work fully (allows for lazy matching) 460 # --------------------------------------- 461 462 $newfile = &fn_kill_sp_patterns($newfile); # remove patterns 463 $newfile = &fn_kill_cwords($file, $newfile); # remove list of words 464 465 # --------------------------------------- 466 # Final cleanup 467 # --------------------------------------- 468 $newfile = &fn_spaces($newfile); # spaces 469 470 $newfile = &fn_front_a($newfile); # Front append 471 $newfile = &fn_end_a($newfile); # End append 472 473 $newfile = &fn_case_fl($newfile); # UC 1st letter of filename 474 $newfile = &fn_lc_all($newfile); # lowercase all 475 $newfile = &fn_uc_all($newfile); # uppercase all 476 $newfile = &fn_truncate($file, $newfile); # truncate file 477 $newfile = &fn_enum($file, $newfile); # Enumerate 478 479 if($file eq $newfile) 480 { 481 &plog(4, "sub run_fixname_subs: no modifications to \"$file\""); 482 } 483 else 484 { 485 &plog(4, "sub run_fixname_subs: \"$file\" to \"$newfile\""); 486 } 487 return $newfile; 488 } 489 490 # Kill word list function 491 # removes list of user set words 492 493 sub fn_kill_cwords 494 { 495 &plog(3, "sub fn_kill_cwords"); 496 my $f = shift; 497 my $fn = shift; 498 my $a = ""; 499 500 if(!$fn) 501 { 502 $fn = $f; 503 } 504 if($main::kill_cwords) 505 { 506 if(-d $f) # if directory process as normal 507 { 508 509 for $a(@main::kill_words_arr_escaped) 510 { 511 $fn =~ s/(^|-|_|\.|\s+|\,|\+|\(|\[|\-)($a)(\]|\)|-|_|\.|\s+|\,|\+|\-|$)/$1.$3/ig; 512 } 513 } 514 else # if its a file, be careful not to remove the extension, hence why we dont match on $ 515 { 516 for $a(@main::kill_words_arr_escaped) 517 { 518 $fn =~ s/(^|-|_|\.|\s+|\,|\+|\(|\[|\-)($a)(\]|\)|-|_|\.|\s+|\,|\+|\-)/$1.$3/ig; 519 } 520 } 521 } 522 523 if($f ne $fn) 524 { 525 &plog(4, "sub fn_kill_cwords: \$f\" to \"$fn\""); 526 } 527 return $fn; 528 } 529 530 sub fn_replace 531 { 532 &plog(3, "sub fn_replace "); 533 my $fn = shift; 534 my $f = $fn; 535 536 if($main::replace) 537 { 538 $fn =~ s/($main::rpwold_escaped)/$main::rpwnew/ig; 539 } 540 if($f ne $fn) 541 { 542 &plog(4, "sub fn_replace: \"$f\" to \"$fn\""); 543 } 544 return $fn; 545 } 546 547 sub fn_kill_sp_patterns 548 { 549 &plog(3, "sub fn_kill_sp_patterns "); 550 my $fn = shift; 551 my $f = $fn; 552 553 if($main::kill_sp_patterns) 554 { 555 for (@main::kill_patterns_arr) 556 { 557 $fn =~ s/$_//ig; 558 } 559 } 560 561 if($f ne $fn) 562 { 563 &plog(4, "sub fn_kill_sp_patterns: \"$f\" to \"$fn\""); 564 } 565 return $fn; 566 } 567 568 sub fn_unscene 569 { 570 &plog(3, "sub fn_unscene "); 571 my $fn = shift; 572 my $f = $fn; 573 574 if($main::unscene) 575 { 576 $fn =~ s/(S)(\d+)(E)(\d+)/$2.qw(x).$4/ie; 577 } 578 579 if($f ne $fn) 580 { 581 &plog(4, "sub fn_unscene: \"$f\" to \"$fn\""); 582 } 583 return $fn; 584 } 585 586 sub fn_scene 587 { 588 &plog(3, "sub fn_scene "); 589 my $fn = shift; 590 my $f = $fn; 591 592 if($main::scene) 593 { 594 $fn =~ s/(^|\W)(\d+)(x)(\d+)/$1.qw(S).$2.qw(E).$4/ie; 595 } 596 597 if($f ne $fn) 598 { 599 &plog(4, "sub fn_scene: \"$f\" to \"$fn\""); 600 } 601 return $fn; 602 } 603 604 sub fn_spaces 605 { 606 &plog(3, "sub fn_spaces"); 607 my $fn = shift; 608 my $f = $fn; 609 610 if($main::spaces) 611 { 612 # underscores to spaces 613 $fn =~ s/(\s|_)+/$main::space_character/g; 614 } 615 if($f ne $fn) 616 { 617 &plog(4, "sub fn_spaces: \"$f\" to \"$fn\""); 618 } 619 return $fn; 620 } 621 622 sub fn_sp_char 623 { 624 &plog(3, "sub fn_sp_char"); 625 my $fn = shift; 626 my $f = $fn; 627 if($main::sp_char) 628 { 629 $fn =~ s/[\~\@\%\{\}\[\]\"\<\>\!\`\'\,\#\(|\)]//g; 630 } 631 if($f ne $fn) 632 { 633 &plog(4, "sub fn_sp_char: \"$f\" to \"$fn\""); 634 } 635 return $fn; 636 } 637 638 # split supposed episode numbers, eg 0103 to 01x03 639 # trys to avoid obvious years 640 641 sub fn_split_dddd 642 { 643 &plog(3, "sub fn_split_dddd"); 644 my $fn = shift; 645 my $f = $fn; 646 647 if($main::split_dddd) 648 { 649 if($fn =~ /(.*?)(\d{3,4})(.*)/) 650 { 651 my @tmp_arr = ($1, $2, $3); 652 if(length $tmp_arr[1] == 3) 653 { 654 $tmp_arr[1] =~ s/(\d{1})(\d{2})/$1."x".$2/e; 655 $fn = $tmp_arr[0].$tmp_arr[1].$tmp_arr[2]; 656 } 657 elsif(length $tmp_arr[1] == 4) 658 { 659 if($tmp_arr[1] !~ /^(19|20)(\d+)/) 660 { 661 $tmp_arr[1] =~ s/(\d{2})(\d{2})/$1."x".$2/e; 662 $fn = $tmp_arr[0].$tmp_arr[1].$tmp_arr[2]; 663 } 664 } 665 666 } 667 } 668 if($f ne $fn) 669 { 670 &plog(4, "sub fn_split_dddd: \"$f\" to \"$fn\""); 671 } 672 return $fn; 673 } 674 675 # case 1st letter 676 # 1st letter of filename should be uc 677 678 sub fn_case_fl 679 { 680 &plog(3, "sub fn_case_fl"); 681 my $fn = shift; 682 my $f = $fn; 683 684 if($main::case) 685 { 686 $fn =~ s/^(\w)/uc($1)/e; 687 } 688 689 if($f ne $fn) 690 { 691 &plog(4, "sub fn_case_fl: \"$f\" to \"$fn\""); 692 } 693 return $fn; 694 } 695 696 # -------------------- 697 # fn_sp_word 698 699 # this func gets passed filename (when needed) 700 # reason being is directory and strings are processed normally 701 # and files are checked for a file extension and handled accordingly 702 # so we need to check if its a file and not a dir 703 # easier to send filename each time than a special flag / string I figured 704 705 sub fn_sp_word 706 { 707 &plog(3, "sub fn_sp_word"); 708 my $f = shift; 709 if(!$f) 710 { 711 &plog(4, "sub fn_sp_word, got passed null"); 712 return; 713 } 714 my $fn = shift; 715 my $fn_old = $fn; 716 717 if($main::sp_word) 718 { 719 my $word = ""; 720 foreach $word(@main::word_casing_arr_escaped) 721 { 722 chomp $word; 723 if(-f $f && !-d $f) # is file and not a directory 724 { 725 $fn =~ s/(^|\s+|_|\.|\(|\[)($word)(\s+|_|\.|\)|\]|\..{3,4}$)/$1.$word.$3/egi; 726 } 727 else # not a file treat as a string 728 { 729 $fn =~ s/(^|\s+|_|\.|\(|\[)($word)(\s+|_|\.|\(|\]|$)/$1.$word.$3/egi 730 } 731 } 732 } 733 if($f ne $fn) 734 { 735 &plog(4, "sub fn_sp_word: \"$fn_old\" to \"$fn\""); 736 } 737 return $fn; 738 } 739 740 sub fn_dot2space 741 { 742 &plog(3, "sub fn_dot2space"); 743 my $f = shift; 744 my $fn = shift; 745 if($main::dot2space) 746 { 747 if(-f $f && !-d $f) # is file and not a directory 748 { 749 $fn =~ s/\./$main::space_character/g; 750 # put last dot back in front of the ext 751 # there may be a cleaner way to do this but oh well 752 $fn =~ s/(.*)($main::space_character)(.{3,4}$)/$1\.$3/g; 753 } 754 else # not a file treat as a string 755 { 756 $fn =~ s/\./$main::space_character/g; 757 } 758 } 759 if($f ne $fn) 760 { 761 &plog(4, "sub fn_dot2space: \"$f\" to \"$fn\""); 762 } 763 return $fn; 764 } 765 766 # Pad digits with " - " (must come after pad digits with 0 to catch any new 767 sub fn_pad_digits 768 { 769 &plog(3, "sub fn_pad_digits"); 770 my $fn = shift; 771 my $f = $fn; 772 if($main::pad_digits) 773 { 774 # optimize me 775 776 my $tmp = $main::space_character."-".$main::space_character; 777 $fn =~ s/($main::space_character)+(\d\d|\d+x\d+)($main::space_character)+/$tmp.$2.$tmp/ie; 778 $fn =~ s/($main::space_character)+(\d\d|\d+x\d+)(\..{3,4}$)/$tmp.$2.$3/ie; 779 $fn =~ s/^(\d\d|\d+x\d+)($main::space_character)+/$1.$tmp/ie; 780 } 781 if($f ne $fn) 782 { 783 &plog(4, "sub fn_pad_digits: \"$f\" to \"$fn\""); 784 } 785 return $fn; 786 } 787 788 sub fn_pad_digits_w_zero 789 { 790 &plog(3, "sub fn_pad_digits_w_zero"); 791 my $fn = shift; 792 my $f = $fn; 793 if($main::pad_digits_w_zero) 794 { 795 # rm extra 0's 796 $fn =~ s/(^|\s+|\.|_)(\d{1,2})(x0)(\d{2})(\s+|\.|_|\..{3,4}$)/$1.$2."x".$4.$5/ieg; 797 798 # pad NxN 799 $fn =~ s/(^|\s+|\.|_)(\dx)(\d)(\s+|\.|_|\..{3,4}$)/$1."0".$2."0".$3.$4/ie; # NxN to 0Nx0N 800 $fn =~ s/(^|\s+|\.|_)(\d\dx)(\d)(\s+|\.|_|\..{3,4}$)/$1.$2."0".$3.$4/ie; # NNxN to NNx0N 801 $fn =~ s/(^|\s+|\.|_)(\dx)(\d\d)(\s+|\.|_|\..{3,4}$)/$1."0".$2.$3.$4/ie; # NxNN to 0NxNN 802 803 # clean scene style 804 # rm extra 0's 805 $fn =~ s/(^s|\s+s|\.s|_s)(\d{1,2})(e0)(\d{2})(\s+|\.|_|\..{3,4}$)/$1.$2."e".$4.$5/ieg; 806 807 $fn =~ s/(^s|\s+s|\.s|_s)(\d)(e)(\d)(\s+|\.|_|\..{3,4}$)/$1."0".$2."0".$3.$4.$5/ie; # sNeN to S0Ne0N 808 $fn =~ s/(^s|\s+s|\.s|_s)(\d\d)(e)(\d)(\s+|\.|_|\..{3,4}$)/$1.$2.$3."0".$4.$5/ie; # sNNeN to sNNe0N 809 $fn =~ s/(^s|\s+s|\.s|_s)(\d)(e)(\d\d)(\s+|\.|_|\..{3,4}$)/$1."0".$2.$3.$4.$5/ie; # SNeNN to S0NeNN 810 } 811 if($f ne $fn) 812 { 813 &plog(4, "sub fn_pad_digits_w_zero: \"$f\" to \"$fn\""); 814 } 815 return $fn; 816 } 817 818 sub fn_digits 819 { 820 &plog(3, "sub fn_digits"); 821 my $fn = shift; 822 my $f = $fn; 823 if($main::digits) 824 { 825 # remove leading digits (Track Nr) 826 $fn =~ s/^\d*\s*//; 827 } 828 if($f ne $fn) 829 { 830 &plog(4, "sub fn_digits: \"$f\" to \"$fn\""); 831 } 832 return $fn; 833 } 834 835 sub fn_enum 836 { 837 &plog(3, "sub fn_enum"); 838 my $f = shift; 839 my $fn = shift; 840 if($main::enum) 841 { 842 my $enum_n = $main::enum_count; 843 844 if($main::enum_pad == 1) 845 { 846 $a = "%.$main::enum_pad_zeros"."d"; 847 $enum_n = sprintf($a, $enum_n); 848 } 849 850 if($main::enum_opt == 0) 851 { 852 if(-d $f) 853 { 854 $fn = $enum_n; 855 } 856 else 857 { 858 # numbers and file ext only 859 $fn =~ s/^.*\././; 860 $fn = "$enum_n"."$fn"; 861 } 862 } elsif($main::enum_opt == 1) 863 { 864 # Insert N at begining of filename 865 $fn = "$enum_n"."$fn"; 866 } elsif($main::enum_opt == 2) 867 { 868 # Insert N at end of filename but before file ext 869 $fn =~ s/(.*)(\..*$)/$1$enum_n$2/g; 870 } 871 $main::enum_count++; 872 } 873 if($f ne $fn) 874 { 875 &plog(4, "sub fn_enum: \"$f\" to \"$fn\""); 876 } 877 return $fn; 878 } 879 880 sub fn_truncate 881 { 882 &plog(3, "sub fn_truncate"); 883 my $f = shift; 884 my $fn = shift; 885 my $tl = ""; 886 887 my $l = length $fn; 888 if($l > $main::max_fn_length && $main::truncate == 0) 889 { 890 &plog(0, "sub fn_truncate: $fn exceeds maximum filename length."); 891 return; 892 } 893 if($l > $main::truncate_to && $main::truncate == 1) 894 { 895 my $file_ext = $fn; 896 $file_ext =~ s/^(.*)(\.)(.{3,4})$/$3/e; 897 my $file_ext_length = length $file_ext; # doesnt include . in length 898 899 # var for adjusted truncate to, gotta take into account file ext length 900 $tl = $main::truncate_to - ($file_ext_length + 1); # tl = truncate length 901 902 # adjust tl to allow for added enum digits if enum mode is enabled 903 if($main::enum && $main::enum_pad) 904 { 905 $tl = $tl - $main::enum_pad_zeros 906 } 907 elsif($main::enum) 908 { 909 $tl = $tl - length "$main::enum_count"; 910 } 911 912 # start truncating 913 914 # from front 915 if($main::truncate_style == 0) 916 { 917 $fn =~ s/^(.*)(.{$tl})(\..{$file_ext_length})$/$2.$3/e; 918 } 919 920 # from end 921 elsif($main::truncate_style == 1) 922 { 923 $fn =~ s/^(.{$tl})(.*)(\..{$file_ext_length})$/$1.$3/e; 924 } 925 926 # from middle 927 elsif($main::truncate_style == 2) 928 { 929 $tl = int ($tl - length $main::trunc_char) / 2; 930 931 $fn =~ s/^(.{$tl})(.*)(.{$tl})(\..{$file_ext_length})$/$1.$main::trunc_char.$3.$4/e; 932 } 933 } 934 if($f ne $fn) 935 { 936 &plog(4, "sub fn_truncate: \"$f\" to \"$fn\""); 937 } 938 return $fn; 939 } 940 941 sub fn_pre_clean 942 { 943 &plog(3, "sub fn_pre_clean"); 944 my $fn = shift; 945 my $f = $fn; 946 if($main::cleanup == 1) 947 { 948 # "fix Artist - - track" type filenames that can pop up when stripping words 949 $fn =~ s/-(\s|_|\.)+-/-/g; 950 951 # rm trailing characters 952 $fn =~ s/(\s|_|\.|-)+(\..{3,4})$/$2/e; 953 954 # remove leading chars 955 $fn =~ s/^(\s|_|\.|-)+//; 956 957 # I hate mpeg or jpeg as extensions personally :P 958 $fn =~ s/\.mpeg$/\.mpg/i; 959 $fn =~ s/\.jpeg$/\.jpg/i; 960 } 961 if($f ne $fn) 962 { 963 &plog(4, "sub fn_pre_clean: \"$f\" to \"$fn\""); 964 } 965 return $fn; 966 } 967 968 sub fn_post_clean 969 { 970 &plog(3, "sub fn_post_clean"); 971 my $f = shift; 972 my $fn = shift; 973 974 if(!$fn) 975 { 976 $fn = $f; 977 } 978 979 if($main::cleanup == 1) 980 { 981 # remove childless brackets () [] {} 982 $fn =~ s/(\(|\[|\{)(\s|_|\.|\+|-)*(\)|\]|\})//g; 983 984 # remove doubled up -'s 985 $fn =~ s/-(\s|_|\.)+-|--/-/g; 986 987 # rm trailing characters 988 $fn =~ s/(\s|\+|_|\.|-)+(\..{3,4})$/$2/; 989 990 # rm leading characters 991 $fn =~ s/^(\s|\+|_|\.|-)+//; 992 993 # rm extra whitespaces 994 $fn =~ s/\s+/ /g; 995 $fn =~ s/$main::space_character+/$main::space_character/g; 996 997 # change file extension to lower case and remove anyspaces before file ext 998 $fn =~ s/^(.*)(\..{3,4})$/$1.lc($2)/e; 999 1000 if(-d $f) 1001 { 1002 $fn =~ s/(\s|\+|_|\.|-)+$//; 1003 } 1004 } 1005 if($f ne $fn) 1006 { 1007 &plog(4, "sub fn_post_clean: \"$f\" to \"$fn\""); 1008 } 1009 return $fn; 1010 } 1011 1012 sub fn_front_a 1013 { 1014 &plog(3, "sub fn_front_a"); 1015 my $fn = shift; 1016 my $f = $fn; 1017 if($main::front_a) 1018 { 1019 $fn = $main::faw.$fn; 1020 } 1021 if($f ne $fn) 1022 { 1023 &plog(4, "sub fn_front_a: \"$f\" to \"$fn\""); 1024 } 1025 return $fn; 1026 } 1027 1028 sub fn_end_a 1029 { 1030 &plog(3, "sub fn_end_a"); 1031 my $fn = shift; 1032 my $f = $fn; 1033 if($main::end_a) 1034 { 1035 $fn =~ s/(.*)(\..*$)/$1$main::eaw$2/g; 1036 } 1037 if($f ne $fn) 1038 { 1039 &plog(4, "sub fn_end_a: \"$f\" to \"$fn\""); 1040 } 1041 return $fn; 1042 } 1043 1044 sub fn_pad_dash 1045 { 1046 &plog(3, "sub fn_pad_dash"); 1047 my $fn = shift; 1048 my $f = $fn; 1049 if($main::pad_dash == 1) 1050 { 1051 $fn =~ s/(\s*|_|\.)(-)(\s*|_|\.)/$main::space_character."-".$main::space_character/eg; 1052 } 1053 if($f ne $fn) 1054 { 1055 &plog(4, "sub fn_pad_dash: \"$f\" to \"$fn\""); 1056 } 1057 return $fn; 1058 } 1059 1060 sub fn_rm_digits 1061 { 1062 &plog(3, "sub fn_rm_digits"); 1063 my $fn = shift; 1064 my $f = $fn; 1065 if($main::rm_digits) 1066 { 1067 my $t_s = ""; 1068 $fn =~ s/\d+//g; 1069 } 1070 if($f ne $fn) 1071 { 1072 &plog(4, "sub fn_rm_digits: \"$f\" to \"$fn\""); 1073 } 1074 return $fn; 1075 } 1076 1077 sub fn_lc_all 1078 { 1079 &plog(3, "sub fn_lc_all"); 1080 # lowercase all 1081 my $fn = shift; 1082 my $f = $fn; 1083 if($main::lc_all) 1084 { 1085 $fn = lc($fn); 1086 } 1087 if($f ne $fn) 1088 { 1089 &plog(4, "sub fn_lc_all: \"$f\" to \"$fn\""); 1090 } 1091 return $fn; 1092 } 1093 1094 sub fn_uc_all 1095 { 1096 &plog(3, "sub fn_uc_all"); 1097 # uppercase all 1098 my $fn = shift; 1099 my $f = $fn; 1100 if($main::uc_all) 1101 { 1102 $fn = uc($fn); 1103 } 1104 if($f ne $fn) 1105 { 1106 &plog(4, "sub fn_uc_all: \"$f\" to \"$fn\""); 1107 } 1108 return $fn; 1109 } 1110 1111 sub fn_intr_char 1112 { 1113 &plog(3, "sub fn_intr_char"); 1114 # International Character translation 1115 # WARNING: This might break really badly on some systems, esp. non-Unix ones... 1116 # if you see alot of ? in your filenames, you need to add the correct codepage for the filesystem. 1117 1118 my $fn = shift; 1119 my $f = $fn; 1120 1121 if($main::intr_char) 1122 { 1123 $fn =~ s/�/Aa/g; 1124 $fn =~ s/�/Ae/g; 1125 $fn =~ s/�/A/g; 1126 $fn =~ s/�/ae/g; 1127 1128 $fn =~ s/�/ss/g; 1129 1130 $fn =~ s/�/E/g; 1131 1132 $fn =~ s/�/I/g; 1133 1134 $fn =~ s/�/N/g; 1135 1136 $fn =~ s/�/O/g; 1137 $fn =~ s/�/Oe/g; 1138 $fn =~ s/�/Oo/g; 1139 1140 $fn =~ s/�/Ue/g; 1141 $fn =~ s/�/U/g; 1142 1143 $fn =~ s/�/a/g; 1144 $fn =~ s/�/a/g; # mems 1st addition to int support 1145 $fn =~ s/�/a/g; 1146 $fn =~ s/�/aa/g; 1147 $fn =~ s/�/ae/g; 1148 $fn =~ s/�/ae/g; 1149 1150 $fn =~ s/�/c/g; 1151 1152 $fn =~ s/�/e/g; 1153 $fn =~ s/�/e/g; 1154 1155 $fn =~ s/�/i/g; 1156 1157 $fn =~ s/�/n/g; 1158 1159 $fn =~ s/�/oo/g; 1160 $fn =~ s/�/oe/g; 1161 $fn =~ s/�/o/g; 1162 $fn =~ s/�/o/g; 1163 1164 $fn =~ s/�/u/g; 1165 $fn =~ s/�/ue/g; 1166 1167 $fn =~ s/�//g; 1168 $fn =~ s/�//g; 1169 $fn =~ s/�//g; 1170 } 1171 if($f ne $fn) 1172 { 1173 &plog(4, "sub fn_intr_char: \"$f\" to \"$fn\""); 1174 } 1175 return $fn; 1176 } 1177 1178 sub fn_case 1179 { 1180 &plog(3, "sub fn_case"); 1181 my $fn = shift; 1182 my $f = $fn; 1183 if($main::case) 1184 { 1185 $fn =~ s/(^| |\.|_|\(|-)([A-Za-z������������������������������])(([A-Za-z������������������������������]|\'|\�|\�|\�)*)/$1.uc($2).lc($3)/eg; 1186 } 1187 if($f ne $fn) 1188 { 1189 &plog(4, "sub fn_case: \"$f\" to \"$fn\""); 1190 } 1191 return $fn; 1192 } 1193 1194 1195 1;