Скипты

В ожидании всеобщего пропадания е-книг из общего доступа :( ну и наверное в приступе хомячьей жадности накачал себе с торрентои прочих мест ( благо без лимитка позволяет ) кучу книг и понял что вручную я их никогда в жизни не отсортирую :( поэтому написал на перле пару скриптов:
Не удается прикрепить файлы поэтому выкладываю так:
fb2utf8.pl
#!/usr/bin/perl -w
# Данный модуль проходит по всем файлам указанной директории и меняет кодировку на истинно верную UTF-8
use strict;
use File::Find;
use File::Path;
use File::Copy;
#use Getopt::Long; # Для параметров командной строки
use Encode 'from_to';
use locale;

@ARGV =('.') unless @ARGV;

#Обработка всех файлов каталога
find (\&main,$ARGV[0]);

sub main {
if (! -d $_) {
# если не каталог
my $fname=$_;
open (OLD,"< $fname") or die "can't open file $fname: $!";
my $cpage = undef;
while (){
$_ =~ /<\?xml.*?encoding\=\"(.*?)\"\?>/smi;
$cpage = lc($1);
last if /<\?xml.*?encoding\=\"(.*?)\"\?>/i;
}
close (OLD);
if ($cpage eq 'windows-1251'){
open (OLD,"< $fname") or die "can't open file $fname: $!";
open (NEW,"> tmpfile") or die "can't open file tmpfile: $!";
select (NEW);

#Читаем весь файл в память
undef $/;
my $data =;
# Меняем кодировку в xml заголовке
$data=~ s/(<\?xml.*?encoding\=\")(.*?)(\"\?>)/$1UTF-8$3/i;
# конвертируем из cp1251 в utf8
from_to($data, 'cp1251','utf8');

print NEW $data;
close(OLD);
close(NEW);

unlink ($fname);# Прощай славный товарисч :(
rename ("tmpfile",'utf8-'.$fname);
print STDOUT "Преобразуем $fname\n";
}else {
print STDOUT "Пропускаем $fname\n";
}
}
}
-----------------------------------------------------------------------------------------------------------------
clear_fb2.pl
#!/usr/bin/perl -w
# Данный модуль проходит по всем файлам указанной директории и удаляет спецсмиволы

use strict;
use File::Find;
use File::Path;
use File::Copy;
#use Getopt::Long; # Для параметров командной строки
use Encode 'from_to';
use locale;

@ARGV =('.') unless @ARGV;

#Обработка всех файлов каталога
find (\&main,$ARGV[0]);

sub main {
if (! -d $_) {
# если не каталог
my $fname=$_;
print STDOUT "Clearing $fname\n";
open (OLD,"< $fname") or die "can't open file $fname: $!";
open (NEW,"> tmpfile") or die "can't open file tmpfile: $!";
select (NEW);
#Читаем весь файл в память
undef $/;
my $data =;
#Чистим трубочиста
$data =~ s/\n+/\n/g;

$data =~ s/\&\s+/\$amp;/g;

$data =~ s/\&([^(amp;|lt;|gt;|nbsp;|"|')])/ $1/g;
#Удалим пустые <>
$data =~ s/<\s*>//g;
# Если не тег то заключим в кавычки
#$data =~ s/<([^a|annotation|author|binary|body|book\-name|book\-title|cite|city|coverpage|custom\-info|date|description|document\-info|email|emphasis|empty\-line|epigraph|fictionbook|first\-name|genre|history|home\-page|id|image|isbn|keywords|lang|last\-name|middle\-name|nickname|p|poem|program\-used|publisher|publish\-info|section|sequence|src\-lang|src\-ocr|src\-url|stanza|strong|style|stylesheet|subtitle|table|td|text\-author|title|title\-info|tr|translator|v|version|year])>/\<$1\>/g;
# Удалим символы и
$data =~ s/\x07|\x15//g;
#Попытка замены << >>
$data =~ s/<>/>/g;
# разделим абзацы
$data =~ s//\n/g;

#Попытка замены примечаний закрытых <>
$data =~ s/<([А-Яа-я])+/<$1/g;
$data =~ s/([А-Яа-я])\d*\.*\"*\'*\s*(>)/$1>/g;

print NEW $data;
close(OLD);
close(NEW);
unlink ($fname);# Прощай славный товарисч :(
my $dubl=int (rand(100));
my $new_file_name="d:\\FB2Test\\".$fname.'_'.$dubl.'.fb2';
#move ("tmpfile",$new_file_name);
rename ("tmpfile",$fname);
}
}
-----------------------------------

сам сортировщик
fb2ren.pl
#!/usr/bin/perl -w
use strict;
use XML::Twig;
use File::Find;
use File::Path;
use File::Copy;
use File::Basename;
use Encode 'from_to';
use locale;

my $codepage ='1'; # Выводить в кодировке 1 - cp1251 0 - cp866
# Если в командной строке пусто то использовать текущий каталог
# Пример вызова fb2true_name.pl каталог_для_обработки каталог_для_выходных_файлов 1-удалять дубликаты 0-оставить на месте
@ARGV =('.') unless @ARGV;

my $out_path=defined($ARGV[1]) ? $ARGV[1]: 'D:\\FB2';

#Обработка всех файлов каталога
find (\&main,$ARGV[0]);

# Формат выходного каталога
# Язык
# Жанр
# Автор (ФИО)
# Серия
# N - название книги (Если серия = Рассказы, файлы не нумеруются)
sub main {
if (! -d $_) {
# если не каталог
my $fname=$_;
my ($base,$dir,$ext) = fileparse($File::Find::name,qr/\.fb2/i);
if ($ext eq '.fb2'){
my @twig_options = (keep_encoding =>1,
twig_roots => { 'title-info'=> 1},
twig_handlers => {
genre => \&genre_title,
author => \&authors,
'book-title' => \&book_title_inf,
sequence => \&sequence_inf,
lang => \&lang_type
}
);
my $twig = XML::Twig->new(@twig_options);
my @state = $twig->safe_parsefile($fname);
if (defined $state[0]){
my $conv= uc($twig->encoding()); #Определяем кодировку файла
$fname=$File::Find::dir.'\\'.$fname;
rename_book($conv,$fname,$out_path);

}else{
my $t_str ="Ошибка обработки файла ".$fname;
show_msg($t_str,$codepage);
#rename ($fname,"err.".$fname);
}
all_clear();
}
}
}
{
my $genre_str =undef;
my $book_title =undef;
my $aut_fml =undef;
my $sequence_title =undef;
my $sequence_number=undef;
my $lang=undef;
my $exist_file_sum=undef;
my $new_file_sum=undef;
my $dir_name =undef;

sub all_clear{
#Очистим хвосты
$genre_str =undef;
$book_title =undef;
$aut_fml =undef;
$sequence_title =undef;
$sequence_number=undef;
$lang=undef;
$dir_name =undef;
}
sub genre_title {
my( $t, $genre_title)= @_;
#$genre_str = $genre_str ? $genre_str.','.$genre_title->text : $genre_title->text ;
#Оставляем только первый жанр из всего списка
$genre_str ||= $genre_title->text ;
}
sub authors {
my( $t, $authors)= @_;
my $first =$authors->first_child_trimmed_text('first-name');
my $middle =$authors->first_child_trimmed_text('middle-name');
my $last =$authors->first_child_trimmed_text('last-name');
my $str=undef;
#$str =join (' ',$last,$first,$middle);
$str =join (' ',$last,$first); # Фамилия Имя
#Оставляем только первый из всего списка
$aut_fml ||=$str ;
#$aut_fml=$aut_fml ? $aut_fml.','.$str : $str; # Если автор уже был, то дописываем иначе присваиваем значение
# print $aut_fml,"\n";
}
sub book_title_inf{
my( $t, $book_title_inf)= @_;
$book_title = $book_title_inf->text;
}
sub sequence_inf{
my( $t, $sequence_inf)= @_;
$sequence_title=$sequence_inf->{'att'}->{'name'};
$sequence_number=$sequence_inf->{'att'}->{'number'};
}
sub lang_type{
my($t,$lang_type)=@_;
$lang=$lang_type->text;
}
sub rename_book{
my( $iconv,$old_file_name,$out_path)= @_;
# проверка на кодировку
$iconv =lc($iconv);
if ($iconv eq 'utf-8'){
from_to($sequence_title, 'utf8', 'cp1251'); # Если Юникод то преобразуем в cp1251
from_to($aut_fml,'utf8', 'cp1251'); # Если Юникод то преобразуем в cp1251
from_to($book_title, 'utf8', 'cp1251'); # Если Юникод то преобразуем в cp1251
}

#Чистим от вредных символов
$genre_str= clear_str($genre_str);
$sequence_title=clear_str($sequence_title);
$book_title=clear_str($book_title);
$aut_fml=clear_str($aut_fml);

# преобразуем фамилию к верному Формату Фамилия Имя
my @tmp = split(' ',lc($aut_fml));
$aut_fml=undef;
if (defined $tmp[0]){
$aut_fml.="\u$tmp[0]";
}
if (defined $tmp[1]){
$aut_fml.=' '."\u$tmp[1]";
}

$dir_name=join('\\',$lang,$genre_str,$aut_fml);

if ($sequence_title){
#$sequence_title=s/(Расказ|Рассказ|Рассказы)/Рассказы/gi;
$dir_name=join('\\',$dir_name,$sequence_title);
#Формируем имя файла
if ($sequence_number=~/\d+/){
my $seqnumber = sprintf( "%02d", $sequence_number );
# Формируем имя файла
$book_title=$seqnumber.' - '.$book_title;
}else{
#Для контроля
my $tmp="В книге $book_title ошибка в номере серии";
show_msg($tmp,$codepage);
}
}
# Присоединяем диск
$dir_name=join('\\',$out_path,$dir_name);
# Проверяем, есть ли такая директория, если нет -- создаем
if (-d $dir_name) {
}else {
mkpath($dir_name);
}

#Проверка есть ли такой файл
my $new_file_name=$dir_name.'\\'.$book_title.'.fb2';
if (-e $new_file_name) {
#Файл существует проверка на дубликат с помощью tthsum
$exist_file_sum=t_sum($old_file_name);
$new_file_sum=t_sum($new_file_name);
if ($exist_file_sum eq $new_file_sum){
# файлики равны и по названию и по содержимому
my $inf_str = "\a".'файл '.$old_file_name.' дубликат к файлу '.$new_file_name.' УДАЛЕН';
show_msg($inf_str,$codepage);
$old_file_name= undef; # Нет больше такго бойца :(
}else {
my $dubl=int (rand(100));
$new_file_name=$dir_name.'\\'.$book_title.'.dubl_'.$dubl.'.fb2';
}
}
if (defined $old_file_name){
move ($old_file_name,$new_file_name);#переносим файл по новому месту
#Для контроля
my $tmp=$new_file_name;
show_msg($tmp,$codepage);
}
all_clear();
}

sub clear_str{
my ($t)= @_;
if (defined $t){
#Чистим на всякий случай от html тегов
$t=~s/\"/ /g;
$t=~s/\>/ /g;
$t=~s/\</ /g;
$t=~s/\'/ /g;
$t=~s/\­//g;

# Убираем все символы кроме букв, цифр, пробелов, точек и дефисов
$t =~ s/[^A-Za-z\d\s\\A-Яa-я\-]+//g;
# удалим \
$t =~s/\x5C/ /g;
# Удалим двойные кавычки << >>
$t =~ s/\xAB/ /g;
$t =~ s/\xBB/ /g;
# Удалим длинное тире заменим на короткое
#$t =~s/-/-/g;
#$t =~s/-/-/g;

#Удалим : и символ с десятичным кодом 133 (то же похож на :)
$t =~ s/\://g;
$t =~ s/\x85//g;
#Удалим `
$t =~ s/\x60//g;
# типографские кавычки
$t =~ s/'//g;
$t =~ s/\x93//g;
$t =~ s/\x94//g;

# Убираем лишние пробелы
$t =~ s/\s+/ /g;
$t =~ s/^\s+//;
$t =~ s/\s+$//;
}else {
$t='';
}

return $t;
}
sub t_sum {
my( $file_name)= @_;
#Проверка на дубликат с помощью tthsum
my $pid = open (F,"C:\\Tools\\tthsum.exe \"$file_name\" |") or die "Couldn't fork $!\n";
my @tth = split (" ",);
close (F);
return $tth[0];
}
sub show_msg{
select (STDOUT);
my($info,$type)= @_;
if ($type eq '0'){
from_to($info, 'cp1251','cp866');
}
print $info,"\n";
}

}

Требует модуль TWIG
tthsum.exe находиться гуглем влет
Кому нужны смотрим комментируем
В планах написать нечто подобное iTunes но для книг

Комментарии

уже пишется - http://home-lib.net/

Запаковал-бы файлы и выложил на обменник куда-нибудь ;-)

1. #Чистим трубочиста: $data =~ s/\n+/\n/g; -- пустые строки автоматически убиты, дизайн книги изуродован.

2. "истинно верная UTF-8"

3. "удаляем спецсимволы": ломать -- не строить!

В общем, стандартные хаки перл-программитста :).
На выходе получится такая каша, которую и глазам жалко показать :)

у меня ругается на строку 35 в первом скрипте
my $data =;

запускаю под Mac OS

X