"Fossies" - the Fresh Open Source Software Archive

Member "namefix.pl/libs/run_namefix.pm" (12 Sep 2009, 5997 Bytes) of package /linux/privat/old/namefix.pl_4.0.2.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "run_namefix.pm" see the Fossies "Dox" file reference documentation.

    1 use strict;
    2 use warnings;
    3 
    4 #--------------------------------------------------------------------------------------------------------------
    5 # Run Namefix
    6 #--------------------------------------------------------------------------------------------------------------
    7 
    8 sub prep_globals 
    9 {
   10     # reset misc vars
   11     $main::STOP     = 0;
   12     $main::id3_change   = 0;
   13         $main::change       = 0;
   14         $main::suggestF     = 0;
   15         $main::tmpfilefound     = 0;
   16         $main::enum_count   = 0;
   17         $main::tags_rm      = 0;
   18         $main::last_recr_dir    = "";
   19 
   20         my $t_s         = "";   # tmp string
   21         my @tmp_arr     = "";
   22 
   23         # escape replace word if regexp is disabled
   24         if($main::disable_regexp == 1) 
   25         {
   26             $main::rpwold_escaped = &escape_string($main::rpwold);
   27         } else 
   28         {
   29             $main::rpwold_escaped = $main::rpwold;
   30         }
   31 
   32     # escape filter string if option enabled
   33         if($main::filter_use_re == 0) 
   34         {
   35             $main::filter_string_escaped = &escape_string($main::filter_string);
   36         }
   37         else 
   38         {
   39             $main::filter_string_escaped = $main::filter_string;
   40         }
   41 
   42     # update killword list if file exists
   43         if(-f $main::killwords_file)    
   44         {
   45         @main::kill_words_arr = &readsf("$main::killwords_file");
   46     }
   47 
   48     # update escaped list of kill_word_arr
   49     @main::kill_words_arr_escaped = ();
   50     for(@main::kill_words_arr) 
   51     {
   52         push (@main::kill_words_arr_escaped, &escape_string($_));
   53     }
   54 
   55     # update kill pattern array if file exists
   56         if(-f $main::killpat_file) 
   57         {
   58                 @main::kill_patterns_arr = &readsf("$main::killpat_file");
   59         }
   60 
   61     # update casing list if file exists
   62         if(-f $main::casing_file) 
   63         {
   64                 @main::word_casing_arr = &readf("$main::casing_file");
   65 
   66         @main::word_casing_arr_escaped = ();    # clear escaped list
   67                 for(@main::word_casing_arr)         # then update 
   68                 {
   69                     push (@main::word_casing_arr_escaped, escape_string($_));
   70                 }
   71         }
   72 }
   73 
   74 sub run_namefix
   75 {
   76     &plog(3, "sub run_namefix:");
   77     
   78     if($main::LISTING)
   79     {
   80         &plog(0, "sub run_namefix: error, a listing is currently being preformed - aborting rename");
   81         return 0;
   82     }
   83     elsif($main::RUN)
   84     {
   85         &plog(0, "sub run_namefix: error, a rename is currently being preformed - aborting rename");
   86         return 0;
   87     }
   88     
   89     $main::RUN      = 1;
   90     $main::orig_dir     = cwd;
   91 
   92         my $t_s         = "";   # tmp string
   93         my @tmp_arr     = "";     
   94     my $txt         = "";
   95     my $a           = "";
   96     my $b           = "";
   97 
   98         chdir $main::dir;
   99     $main::dir = cwd();
  100     &clear_undo;
  101     &prep_globals;
  102 
  103     if(!$main::CLI)
  104     {
  105         &hlist_clear;
  106         &nf_print("..", "<MSG>");
  107     }
  108     
  109         if(!$main::recr) 
  110         {
  111         my @dirlist = &dir_filtered($main::dir);
  112 
  113                 foreach(@dirlist) 
  114                 {
  115                         if(!$_) # stop warnings getting spat out
  116                         {
  117                                 next;
  118                         }
  119                         if($main::proc_dirs) 
  120                         {
  121                                 &fixname($_);
  122                                 next;
  123                         }
  124                         elsif(! -d $_) 
  125                         {
  126                                 &fixname($_);
  127                         }
  128                 }
  129         }
  130         if($main::recr) 
  131         {
  132         &plog(4, "sub run_namefix: recursive mode");
  133         @main::find_arr = ();
  134         find(\&find_fix, "$main::dir");
  135         &find_fix_process;
  136         }
  137 
  138     # print info
  139 
  140         $t_s = "have";
  141         if ($main::testmode == 1) 
  142         {
  143             $t_s = "would have";
  144         }
  145         &nf_print(" ", "<MSG>");
  146     &nf_print("$main::change files $t_s been modified", "<MSG>");
  147 
  148     if($main::id3_mode) 
  149     {
  150         &nf_print("$main::id3_change mp3s tags $t_s been updated.", "<MSG>");
  151     }
  152         if($main::tags_rm) 
  153         {
  154             &nf_print("$main::tags_rm mp3 tags $t_s been removed", "<MSG>");
  155         }
  156         &nf_print(" ", "<MSG>");
  157 
  158 
  159         if($main::suggestF != 0) 
  160         {
  161             &nf_print("namefix.pl was unable to rename $main::suggestF files.\nPerhaps you should enable \"FS Fix\".", "<MSG>");
  162         &nf_print(" ", "<MSG>");
  163         }
  164 
  165         if($main::tmpfilefound != 0) 
  166         {
  167         &plog(0, "namefix.pl found tmp some of its own tmp files, this should not happen. Please check the following list of files.\n$main::tmpfilelist\n");
  168     }
  169 
  170     &nf_print("namefix.pl $main::version by $main::author", "<MSG>");
  171 
  172         # cleanup
  173 
  174     $main::testmode = 1;    # return to test mode for safety :)
  175     $main::RUN = 0;     # finished renaming - turn off run flag
  176     chdir $main::dir;   # return to users working dir
  177 }
  178 
  179 sub find_fix
  180 {
  181     # perls file find will not pass a var to a sub - instead your stuck with $_
  182     # Im not a fan off this, I like to use my own vars in subs and not mess with perls globals
  183     # so here is my simple work around to keep the fixname sub neat and tidy.
  184 
  185     # find seems to change dir all on its own, which is a pain when you want to pass the results to an array
  186     # so this fix now also includes main_dir tracking
  187 
  188     my $file = $_;
  189     my $d = cwd();
  190     &plog(3, "sub find_fix: \"$d\" \"$file\"");
  191     push @main::find_arr, "$d/$file";
  192     return 1;
  193 }
  194 
  195 
  196 sub find_fix_process
  197 {
  198     # this sub should recieve an array of files from find_fix
  199 
  200     my @list = @main::find_arr;
  201     my $d = cwd();
  202     my $file = "";
  203     my $dir = "";
  204 
  205     &plog(3, "sub find_fix_process:");
  206 
  207     for $file(@main::find_arr)
  208     {
  209         &plog(4, "sub find_fix_process: list line \"$file\"");
  210         $file =~ m/^(.*)\/(.*?)$/;
  211         $dir = $1;
  212         $file = $2;
  213         &plog(4, "sub find_fix_process: dir = \"$dir\"");
  214         &plog(4, "sub find_fix_process: file = \"$file\"");
  215 
  216         chdir $dir; # change to dir containing file
  217         &fixname($file);
  218         chdir $d;   # change back to dir sub started in
  219     }
  220     &plog(3, "sub find_fix_process: done");
  221     return 1;
  222 }
  223 
  224 1;