[perl] torrent_renamer

Discussion in 'PHP' started by eLWAux, 20 Nov 2008.

  1. eLWAux

    eLWAux Elder - Старейшина

    Joined:
    15 Jun 2008
    Messages:
    860
    Likes Received:
    616
    Reputations:
    211
    torrent_renamer
    by eLWAux
    thnk. Kaimi

    [​IMG]
    скрипт которий переименовивает .torrent
    (маски: [torrents.ru].??????????.torrent, где ?- какая то цифра)
    на файл с именем первого файла торрента ;)
    например:
    в папке со скриптом єсть файл: [torrents.ru].13433188.torrent
    после запуска скрипт, имя файла будет:
    Madagaskar.2.2008.aviю.torrent


    для запуска нужет ActivePerl или другая среда

    в .pl файле можна изменить:
    $dir
    папка, в которой переименовываться торренти:
    (например: $dir= '.'; -поточная папка
    $dir= 'c:\windows' -диск c:, папка windows
    )

    $pr
    текст, которий будет добавлен до имени нового файла с самого начала
    (например: $pr= 'test'; - тогда все переименование файли будут иметь имя: test????.torrent)

    использование:
    1( кладем скрипт в папку с торрентами
    2( запускаем скрипт
    3( после завершения работи, скрипт покажет статистику:
    renamed: количесто_переименованих_файлов
    [%] количесто_перемменованих_файлов_в_проценатах% renamed!
    4( смотрим в файл result_rename.txt, там полная статистика переименованих и неПереименованих файлов

    пример файла result_rename.txt:
    єсли отредактировать скрипт и сделать так что $pr='[torrent]';

    тогда после работи скрипта в файле result_rename.txt ми увидем следуеще:
    как видно все переименование файли сначала имеют текст:
    [torrent], то что ми установили в $pr..

    p.s.:
    1( скрипт некорректо отображает UTF8 текст, как исправить незнаю; кто подскажет, буду только рад)
    2( все замечания\предложения пишем тут

    также, я через несколько дней доделаю скрипт, которий проверяет какие торренти загружени, какие нет, и в соответствии перемещает торретки в другие папки..

    ==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-
    ==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-
    ==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-
    perl::code
    Code:
    system('cls');
    
    ##########################################################################
    ##########################################################################
    ##########################################################################
    
     $dir	        = '.';			#without /
     $pr	 	= '[torrent]';
    
    ##########################################################################
    ##########################################################################
    ##########################################################################
    
    sub saveFile
    {
    	open(myFILE,">$_[0]") || die "error: $!";
    	print myFILE $_[1];
    	close(myFILE);
    } 
    
    sub cyr #Kaimi modifed
    {
    	($_)=@_;
    	y/А-яЁё/\x80-\xaf\xe0-\xf1/;
    	return $_;
    }
    
    sub read_str
    {
    	if ($_[0] =~ /:$_[1](\d{0,4}):/)
    	{return substr($_[0], index($_[0],$_[1])+length($_[1])+length($1)+1, $1)}
    	else {return '';}
    }
    
    sub read_num
    {
    	if ($_[0] =~ /$_[1]i(\d{0,64})e/)
    	{return $1} else {return ''}
    }
    
    sub rename_torrent #Kaimi modifed
    {
    	my $new_name;
    	$new_name=cyr(read_str($_[0],'name'));
    	$new_name=~s/\[torrents.ru\]//ge;
    	return $new_name.'.torrent';
    }
    
    ##########################################################################
    ##########################################################################
    ##########################################################################
    
    system('cls');
    
    print "--====--=--=- eLWAux -=-==-====--\n";
    print "--===-== torrent renamer -=-===--\n";
    print "--====-==-=-=-=-=-=-=-=--==-===--\n\n";
    
    opendir(TEMPDIR,$dir) or die("[-] Error ($!)..");
    @FILES=grep(/\.torrent$/i, readdir TEMPDIR);
    closedir(TEMPDIR);
    
    print '[i] '.@FILES." *.torrent's found\n";
    print '[i] '.localtime(time())."\n";
    
    print "--====-==-=-=-=-=-=-=-=--==-===--\n\n";
    
    $g=0;$bef='';$aft='';$nren='';
    foreach my $file(@FILES) {
    	$res='';
            open(DESC, $file);
            read(DESC,$res,-s $file);
            close(DESC);
    
    	print '    '.cyr($file)."\n";
    	$n = $pr.rename_torrent($res);
    	if ($n eq $file)
    		{ print '[-] '.$n."\n";
    		  $nren.=$n."\n";
    		} else
    		{ $g++;
    		  rename $file,$n;
    		  $bef.=$file."\n";
    		  $aft.=$n."\n";
    		  print '[+] '.$n."\n";
    		}	
    	$i++;
    	}
    
    print '[i] renamed: '.$g."\n";
    print '[%] '.int(($g/@FILES)*100).'% renamed!';
    
    saveFile('result_rename.txt',
    	"renamed: $g files\n".
    	"         ".int(($g/@FILES)*100)."% of all file(s)\n".
    	"==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-\n".
    	"before:\n".
    	"==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-\n".
    	$bef."\n".
    	"==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-\n".
    	"after:\n".
    	"==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-\n".
    	$aft."\n".
    	"==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-\n".
    	"\nnot renamed:\n".
    	"==-=--==--=--=-=-=-=-=-=-=-=--==--==-=-=--=-=--==-\n".
    	$nren."\n");
    <STDIN>;
     
    #1 eLWAux, 20 Nov 2008
    Last edited: 24 Nov 2008
    4 people like this.
  2. MaTpOc

    MaTpOc Elder - Старейшина

    Joined:
    5 May 2008
    Messages:
    633
    Likes Received:
    475
    Reputations:
    25
    А можно поподробней для чего и что делает этот скрипт.
     
    1 person likes this.
  3. eLWAux

    eLWAux Elder - Старейшина

    Joined:
    15 Jun 2008
    Messages:
    860
    Likes Received:
    616
    Reputations:
    211
    когда качаеш торренти, то они имеют названия, типа: [torrent].12937198.torrent или что то подобное..; так вот насобиралося у тебя (как у меня;) штук 100таких файлов с непонятним названиям.. смотриш ти на весь єтот бред и думаеш "блин.. и что я с єтого посмотрел?".. можна каждий торрент по-очереди в прогу кидать и смотреть что за торрент., но єто не виход, так как 100 файлов заи**ся смотреть..

    так вот я написал скрипт, которий єти все торренти с непонятним названиям переименовивает в "нормальний" вид..
    пр: нашел ти на форуме torrents.ru фильм бригаду. скачал торрент 1239888217.torrent. закачал бригаду. посмотрел. удалил фильм. скачал потом єщо один фильм, єщо один, .... и так насобиралось много торрентов. и ти внось захотел посмотреть бригаду, но не помниш названия торрета. кладеш скрипт в папку с єтими *.torrent файлами, запускаеш. после завершения роботи скрипт переименует 1239888217.torrent в Brigada.torrent

    а в общем , скрипт просто для удобства)
    превращает "мусор" в ценность)
     
  4. Kaimi

    Kaimi Well-Known Member

    Joined:
    23 Aug 2007
    Messages:
    1,732
    Likes Received:
    809
    Reputations:
    231
    Моно сделать так
    Code:
    sub cyr
    {
    	($_)=@_;
    	y/А-яЁё/\x80-\xaf\xe0-\xf1/;
    	return $_;
    }
    
    Code:
     
    open(DESC, $FILES[$i]);
    read(DESC,$res,-s $FILES[$i]);
    close(DESC);
    
    мне кажется так красивее
    Code:
    foreach my $file(@FILES) {
    
    А зачем переменная $old_name ? зачем юзать local? в мануале вроде пишут что лучше my юзать...
     
    _________________________
  5. eLWAux

    eLWAux Elder - Старейшина

    Joined:
    15 Jun 2008
    Messages:
    860
    Likes Received:
    616
    Reputations:
    211
    Kaimi, спасибо за ошибки)
    кстате, sub cyr твоя функция)
     
  6. Solker

    Solker Elder - Старейшина

    Joined:
    4 May 2006
    Messages:
    175
    Likes Received:
    53
    Reputations:
    18
    То же самое, только на PHP и в 2 раза меньше.
    Плюс корректно работает с UTF-8.

    PHP:
    <?php

    $dir 
    scandir('.');
    foreach(
    $dir as $filename)
    {
      if(
    $filename == '.' or $filename == '..') continue;
      if(
    substr($filename,-7) != 'torrent') continue;

      
    $handle fopen($filename"r");
      
    $buffer fgets($handle4096);
      
    fclose($handle);
      
      
    preg_match('#\[torrents.ru\].(.+?).torrent#',$filename,$id);
      
    $result explode(':'$buffer);

      foreach(
    $result as $key => $date)
      {
        if(
    substr($date,0,4)=='name') {
          
    $name str_replace(' ','.',substr($result[$key+1],0,strlen($result[$key+1])-2));
          break;
        } 
      }
      
      if(
    detectUTF8($name)) $name iconv('UTF-8''windows-1251'$name);
      
      echo 
    "[{$id[1]}].$name.torrent<br>\n"//Or Rename File
    }

    function 
    detectUTF8($string)
    {
            return 
    preg_match('%(?:
            [\xC2-\xDF][\x80-\xBF]        # non-overlong 2-byte
            |\xE0[\xA0-\xBF][\x80-\xBF]               # excluding overlongs
            |[\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}      # straight 3-byte
            |\xED[\x80-\x9F][\x80-\xBF]               # excluding surrogates
            |\xF0[\x90-\xBF][\x80-\xBF]{2}    # planes 1-3
            |[\xF1-\xF3][\x80-\xBF]{3}                  # planes 4-15
            |\xF4[\x80-\x8F][\x80-\xBF]{2}    # plane 16
            )+%xs'
    $string);
    }

    ?>
    Не понимаю, зачем под такой бред создавать отдельную тему, и ставить свои копирайты.
     
    #6 Solker, 23 Nov 2008
    Last edited: 23 Nov 2008
  7. Kaimi

    Kaimi Well-Known Member

    Joined:
    23 Aug 2007
    Messages:
    1,732
    Likes Received:
    809
    Reputations:
    231
    Эм, это где ты у меня её видел?
     
    _________________________
  8. eLWAux

    eLWAux Elder - Старейшина

    Joined:
    15 Jun 2008
    Messages:
    860
    Likes Received:
    616
    Reputations:
    211
    Solker,
    тема создана чтоб показать роботу с torrent'ами на перле
    копирайти поставил потому что я написал с нуля сам
    detectUTF8 всегда можно добавить
    размер моего скрипта больше твоего (єсли єто твой скрипт..) потому что у меня все разбито про функциях, єсли все слепить, то получиться не больше твоего

    точно не помню, но вроде где-то в разделе "для новичков" ;)
     
  9. Solker

    Solker Elder - Старейшина

    Joined:
    4 May 2006
    Messages:
    175
    Likes Received:
    53
    Reputations:
    18
    Ну так и добавь.
     
  10. eLWAux

    eLWAux Elder - Старейшина

    Joined:
    15 Jun 2008
    Messages:
    860
    Likes Received:
    616
    Reputations:
    211
    up

    Kaimi, ошибки исправил) спасибо)
    Solker, UTF поддержки пока нет)