"Fossies" - the Fresh Open Source Software Archive

Member "namefix.pl/libs/gui/blockrename.pm" (13 Dec 2008, 10145 Bytes) of package /linux/privat/old/namefix.pl_4.0.2.tar.gz:

    1 use strict;
    2 use warnings;
    3 
    4 #-----------------------------------------------------------------------------------------------------
    5 # blockrename - displays block rename window
    6 #-----------------------------------------------------------------------------------------------------
    7 
    8 sub blockrename 
    9 {
   10     &plog(3, "sub blockrename");
   11 
   12     my @tmp = ();   
   13 
   14     # create block rename window
   15 
   16         my $br_window = $main::mw -> Toplevel();
   17         $br_window -> title
   18         (
   19             "Block Rename"
   20         );
   21     my $balloon = $br_window->Balloon();
   22 
   23     my $txt_frame = $br_window->Frame()
   24     ->pack
   25     (
   26         -side => 'top',
   27         -fill=>"both",
   28         -expand=>1,
   29     );
   30     my $button_frame = $br_window->Frame()
   31     ->pack
   32     (
   33         -side => 'bottom',
   34         -fill=>"both",
   35     );
   36 
   37     # Text box 1
   38     # this text box is the before filenames
   39     # Editing is allowed in this textbox so you can easily remove 1 file from the list.
   40 
   41         our $txt = $txt_frame -> Scrolled
   42         (
   43             'Text',
   44                 -scrollbars=>"osoe",
   45             -font=>$main::dialog_font,
   46         -wrap=>'none',
   47         )
   48         ->grid
   49     ( 
   50         -in => $txt_frame,
   51         -row=>1,
   52         -column => '1',
   53         -sticky => 'nesw',
   54     );
   55 
   56         $txt->menu(undef);
   57 
   58     # Text box 2
   59     # this text box is the after filenames
   60     # this is where the user usually copy and pastes a list of filenames into.
   61 
   62         our $txt_r = $txt_frame -> Scrolled
   63         (
   64             'Text',
   65                 -scrollbars=>"osoe",
   66 #                -width=>$lw,
   67 #                -height=>$lh,
   68             -font=>$main::dialog_font,
   69         -wrap=>'none',
   70         )
   71         ->grid
   72     ( 
   73         -in => $txt_frame,
   74         -row=>1,
   75         -column => '2',
   76         -sticky => 'nesw',
   77     );
   78         $txt_r->menu(undef);
   79 
   80     # weight text boxes in txt_frame (ensures even resive apparently)
   81     $txt_frame->gridRowconfigure(1, -weight=>1, -minsize =>50 );
   82     $txt_frame->gridColumnconfigure(1, -weight=>1, -minsize =>50 );
   83     $txt_frame->gridColumnconfigure(2, -weight=>1, -minsize =>50 );
   84 
   85     my $frm = $button_frame -> Frame()
   86         -> grid
   87         (
   88             -row => 4,
   89             -column => 1,
   90             -columnspan => 2,
   91             -sticky=>"ne"
   92         );
   93 
   94     # Cleanup button
   95 
   96         $frm -> Button
   97         (
   98             -text=>"Cleanup",
   99             -activebackground => 'white',
  100             -command => sub 
  101             {
  102                 &br_cleanup;
  103             }
  104         )
  105         -> pack(-side => 'left');
  106 
  107     # Clear button
  108     # clears text in right hand box
  109     # usefull for pasting filenames from clipboard.
  110 
  111         my $clear = $frm -> Button
  112         (
  113             -text=>"Clear",
  114             -activebackground => 'white',
  115             -command => sub 
  116             {
  117                 $main::txt_r->delete('0.0','end');
  118             }
  119         )
  120         -> pack(-side => 'left');
  121     $balloon->attach
  122     (
  123         $clear,
  124         -msg => "Clears Text In Right hand text box"
  125     );
  126 
  127     # Filter button
  128     # enables use of mainwindows filter
  129 
  130     my $filt = $frm -> Checkbutton
  131     (
  132         -text=>"Filter",
  133         -variable=>\$main::FILTER,
  134         -command=> sub 
  135         {
  136             if($main::FILTER && $main::filter_string eq "") # dont enable filter on an empty string
  137             {
  138                 &plog(1, "sub blockrename: tried to enable filtering with an empty filter");
  139                 $main::FILTER = 0;
  140             }
  141             else
  142             {
  143                 &txt_reset;
  144             }
  145 
  146         },
  147         -activeforeground => "blue",
  148     )
  149         -> pack(-side => 'left');
  150 
  151     # Preview button
  152     # displays a window with preview of results
  153 
  154     my $preview = $frm -> Checkbutton
  155     (
  156         -text=>"Preview",
  157         -variable=>\$main::testmode,
  158         -activeforeground => "blue"
  159     )
  160         -> pack(-side => 'left');
  161     $balloon->attach
  162     (
  163         $preview,
  164         -msg => "Preview changes that will be made.\n\nNote: This option always re-enables after a run for safety."
  165     );
  166 
  167     # STOP button
  168 
  169         $frm -> Button
  170         (
  171             -text=>"STOP !",
  172             -activebackground => 'red',
  173             -command => sub
  174         {
  175             $main::STOP = 1;
  176         }
  177         )
  178         -> pack(-side => 'left');
  179 
  180     # LIST button
  181 
  182         my $list = $frm -> Button
  183         (
  184             -text=>"LIST",
  185             -activebackground => 'orange',
  186             -command => \&txt_reset
  187         )
  188         -> pack(-side => 'left');
  189 
  190     $balloon->attach
  191     (
  192         $list,
  193         -msg => "List Directory / Reset Text"
  194     );
  195 
  196     $frm -> Label
  197     (
  198         -text=>"  "
  199     )
  200     -> pack(-side => 'left');
  201 
  202     # RUN button
  203 
  204         $frm -> Button
  205         (
  206             -text=>"RUN",
  207             -activebackground => 'green',
  208             -command => sub 
  209             {
  210             if($main::testmode == 0)
  211             {
  212                 $main::BR_DONE = 1;
  213                 &br();
  214                 $main::testmode = 1;
  215             }
  216             else
  217             {
  218                 &br_preview();
  219             }
  220             }
  221         )
  222         -> pack(-side => 'left');
  223 
  224     $frm -> Label
  225     (
  226         -text=>"    "
  227     )
  228     -> pack(-side => 'left');
  229 
  230     # Close button
  231 
  232         $frm -> Button
  233         (
  234             -text=>"Close",
  235             -activebackground => 'white',
  236             -command => sub 
  237             {
  238             if($main::BR_DONE)
  239             {
  240                 $main::BR_DONE = 0;
  241                     &ls_dir;
  242             }
  243                 destroy $br_window;
  244             }
  245         )
  246         -> pack(-side => 'left');
  247     &txt_reset;
  248 }
  249 
  250 sub br_cleanup
  251 {
  252     &plog(3, "sub br_cleanup");
  253     &prep_globals;
  254     my @flist = ();
  255     my @list = ();
  256     my $c = 0;
  257     my $file = "";
  258     my $dtext   = "";
  259 
  260     @flist = split(/\n/, $main::txt -> get('1.0', 'end'));
  261     @list = split(/\n/, $main::txt_r -> get('1.0', 'end'));
  262 
  263     &br_txt_r_clear;
  264     for my $i(@list)
  265     {
  266         $file = $flist[$c];
  267         $c++;
  268         if(!$i || !$file)   # avoid sending null entrys to subs below
  269         {
  270             next;
  271         }
  272         &plog(4, "sub br_cleanup: processing \"$file\" -> \"$i\"");
  273         $i = &br_ed2k_cleanup($i);      # strip ed2k link info
  274         $i = &br_txt_cleanup($i);       # strip cleanup any crap trailing filename
  275         $i = run_fixname_subs($file, $i);   # apply fixname routines ($file is needed, else some funcs mangle extensions)
  276         
  277     }
  278 
  279     $dtext = join ("\n", @list);
  280         $main::txt_r-> insert
  281         (
  282             'end',
  283             "$dtext"
  284         );
  285 }
  286 
  287 sub br_txt_r_clear
  288 {
  289     &plog(3, "sub br_txt_r_clear");
  290     $main::txt_r->delete('0.0','end');
  291 }
  292 
  293 sub txt_reset
  294 {
  295     &plog(3, "sub txt_reset");
  296     &prep_globals;
  297         my $dtext = join ("\n", &br_readdir($main::dir));
  298         &plog(4, "sub txt_reset: dtext: $dtext");
  299 
  300     $main::txt->delete('0.0','end');
  301     $main::txt_r->delete('0.0','end');
  302 
  303         $main::txt-> insert
  304         (
  305             'end',
  306             "$dtext"
  307         );
  308         $main::txt_r-> insert
  309         (
  310             'end',
  311             "$dtext"
  312         );
  313 }
  314 
  315 sub br
  316 {
  317     &plog(3, "sub br:");
  318     
  319     if($main::LISTING)
  320     {
  321         &plog(0, "sub br: error, a listing is currently being preformed - aborting rename");
  322         return 0;
  323     }
  324     elsif($main::RUN)
  325     {
  326         &plog(0, "sub br: error, a rename is currently being preformed - aborting rename");
  327         return 0;
  328     }
  329     
  330     $main::STOP     = 0;
  331     $main::RUN  = 1;
  332 
  333     my $result_text = "";
  334     my @new_l   = split(/\n/, $main::txt_r -> get('1.0', 'end'));
  335     my @old_l   = split(/\n/, $main::txt -> get('1.0', 'end'));
  336     my @a       = ();
  337     my @b       = ();
  338     my $c       = 0;
  339     my $of      = "";   # old file
  340     my $nf      = "";   # new file
  341 
  342     # clean arrarys of return chars
  343     # using chomp caused issues with filenames containing whitespaces at beginging or the end
  344     # such as "hello.mp3 " or " hello.mp3"
  345     for(@new_l)
  346     {
  347         s/\n|\r//g;
  348     }
  349     for(@old_l)
  350     {
  351         s/\n|\r//g;
  352     }
  353 
  354     &clear_undo;
  355     &prep_globals;
  356 
  357     &plog(4, "sub br: checking that files to be renamed exist");
  358     for $of(@old_l)
  359     {
  360         &plog(4, "sub br: checking \"$of\"");
  361         if(!-f $of)
  362         {
  363             &plog(0, "sub br: ERROR: old file \"$of\" does not exist");
  364             $main::RUN = 1;
  365             return 0;
  366         }
  367     }
  368 
  369     if($#old_l < $#new_l || $#old_l > $#new_l)
  370     {
  371         &plog(0, "sub br: ERROR: length of new and old list does not match");   # prevent possible user cockup
  372         $main::RUN = 0;
  373         return 0;
  374     }
  375 
  376     while($c <= $#old_l)    # check for changes - then rename
  377     {
  378         if($main::STOP == 1)
  379         {
  380             $main::RUN = 0;
  381             return 0;
  382         }
  383 
  384         $of = $old_l[$c];
  385         $nf = $new_l[$c];
  386         $c++;
  387 
  388         &plog(4, "sub br: processing \"$of\" -> \"$nf\"");
  389 
  390         if(!$nf) # finish when we hit a blank line, else we risk zero'ing the rest of the filenames
  391         {
  392             &plog(4, "sub br: no new filename for \"$of\" provided, assuming end of renaming");
  393             last;
  394         }
  395 
  396         
  397         $nf = &br_ed2k_cleanup($nf);        
  398         &plog(4, "sub br: renaming \"$of\" -> \"$nf\"");
  399 
  400         if($of eq $nf)
  401         {
  402             next;
  403         }
  404 
  405         if(&fn_rename ($of, $nf))
  406         {
  407             push @main::undo_pre, $main::cwd."/".$of;
  408             push @main::undo_cur, $main::cwd."/".$nf;
  409             push @a, $of;
  410             push @b, $nf;
  411             $result_text .= "\"$of\" -> \"$nf\"\n";
  412             &plog(4, "sub br: renamed");
  413         }
  414         else
  415         {
  416             &plog(0, "sub br: rename failed !");
  417         }
  418     }
  419     &br_show_lists("Block Rename Results", \@a, \@b);
  420     &txt_reset;
  421 
  422     $main::RUN = 0;
  423     return 1;
  424 }
  425 
  426 
  427 sub br_ed2k_cleanup
  428 {
  429     my $link = shift;
  430     &plog(3, "sub br_ed2k_cleanup: \"$link\"");
  431     if($link =~ m/^ed2k:\/\/\|file\|(.*?)\|/i)
  432     {
  433         &plog(4, "sub br_ed2k_cleanup: \"$link\" -> \"$1\"");
  434         $link = $1;
  435     }
  436 
  437     return $link;
  438 }
  439 sub br_txt_cleanup
  440 {
  441     my $link = shift;
  442     &plog(3, "sub br_txt_cleanup: \"$link\"");
  443     if($link =~ m/^\s*(.*\.($main::file_ext_2_proc))\s+/)
  444     {
  445         &plog(4, "sub br_txt_cleanup: \"$link\" -> \"$1\"");
  446         $link = $1;
  447     }
  448 
  449     return $link;
  450 }
  451 
  452     
  453 sub br_readdir 
  454 {
  455     my $d = shift;
  456         my @dl_1 = ();
  457         my @dl_2 = ();
  458 
  459     &plog(3, "sub br_readdir: \"$d\"");
  460 
  461     opendir(DIR, "$d") or &plog(0, "sub br_readdir: cant open directory $d, $!");
  462     @dl_1 = CORE::readdir(DIR);
  463         closedir DIR;
  464 
  465         for(@dl_1) 
  466         {
  467             s/^\s+|\s+$//g;
  468             if($_ eq "." || $_ eq ".." || $_ eq "") 
  469             {
  470                     next;
  471                 }
  472 
  473                 if(!$main::proc_dirs && -d $_) 
  474                 {
  475                     next;
  476                 }
  477 
  478                 if(!$main::ig_type == 0 && $_ !~ /\.($main::file_ext_2_proc)$/i)
  479                 {
  480                     next;
  481                 }
  482 
  483         if($main::FILTER && !&match_filter($_))
  484         {
  485             next;
  486         }
  487 
  488                 push @dl_2, $_;
  489         }
  490 
  491         return &ci_sort(@dl_2);
  492 }
  493 
  494 
  495 1;
  496