#!c:/bin/perl/bin/perl

use 5.010;
use Getopt::Std;
use File::Spec::Functions 'rel2abs';
use File::Basename;
use File::Copy;
use Tie::File;
use Data::Dumper;
#use diagnostics;

my $USAGE = <<__EOU;

Использование: $0 [-n] [-f] [-v] вх_файл_БД [вых_файл_БД]

Описание:
  Удалить и сгенерировать заново поля с авторами в записях ASP из полей с
  авторами в записи NJ.
  Перед использованием _внимательно_ ознакомиться с заметками.

Параметры:
  -n            Не править файл БД
  -f            Вносить изменения в записи ASP несмотря на наличие некоторых
                некорректных данных в полях авторов в записи NJ
                (пока не имеет никакого действия)
  -v            Повысить разговорчивость
  -h            Вывести эту справку
  вх_файл_БД    Входной файл БД в текстовом формате, кодировка windows 1251
  вых_файл БД   Выходной файл БД (требуется, если опция -n не указана)

Заметки:
  Для "связывания" полей 922 записи NJ с записями ASP используются данные о
  странице, заглавии и, разумеется, шифре. Т.о. минимумом корректных данных в
  записях NJ будет содержимое 922^C (заглавие), 922^4 (страницы), 922^F, 922^2,
  922^3, а также 903 (шифр). "Другие авторы" обрабатываются по аналогии с ТВП
  STN, т.е. читаются из полей 926. В записях ASP для "связывания" используются
  200^A (заглавие), 463^S (страницы), 463^W (шифр).
  
  Количество обрабатываемых подполей 926 ограничено автогенерируемыми из 922^W,
  поскольку поля 926 нашей библиотеке административно запрещено редактировать
  вручную.
  
  Для автокорректировки сперва приведите в порядок поля 922, 926. Программа
  во многих местах полагается на корректность этих полей. Однако, если
  соберётесь править заглавия и страницы -- это нужно будет сделать и в
  NJ и в ASP (поскольку эти данные используются этой программой для связывания
  записей).
  
  Список всех обрабатываемых полей в записи NJ, имеющих отношение к авторам:
  
  Для первого автора:
  922^F (ФИО)
  922^? (Расширение инициалов, если в 922^F -- инициалы)
  922^X (Признак недопустимости инвертирования ФИО, а также кол-во слов
        фамилии. Если поля нет или пустое -- будем искать положение инициалов
        в 922^F, если в 922^F нечто странное -- сообщим об этом. Если в поле
        целое число больше нуля -- проверим, есть ли столько слов в 922^F,
        и будем считать, что у нас инициалы в конце 922^F. Иначе в поле
        ошибочное значение)
  922^Q (Функция автора, например "редактор" или "составитель")
  
  Для второго автора:
  922^2 (ФИО)
  922^, (аналогично 922^?)
  922^< (аналогично 922^X)
  922^S (аналогично 922^Q)
  
  Для третьего автора:
  922^3 (ФИО)
  922^; (аналогично 922^?)
  922^> (аналогично 922^X)
  922^T (аналогично 922^Q)
  
  Для других авторов:
  926^A (Фамилия)
  926^B (Инициалы)
  926^G (Расширение инициалов)
  ("функция" не входит в список автогенерируемых)
  
  Касательно методик ввода авторов, принятых в разных библиотеках:
  В ННМБУ, например (не знаю, насколько "всегда", но говорят, что делают именно
  так), если авторов больше 3-х, то всех их они вводят в 922^W.
  Мой (и "моих" библиотек) подход состоит же в заполнении всех авторов,
  независимо от их количества, начиная с 922^F.
  Такое различие легко конвертировать sed'ом, но в этой программе я не буду
  учитывать эти различия и буду считать правильным только "свой" подход.
  Т.о. заполнение авторов должно начинаться с 922^F независимо от их
  количества.
  
  Проверьте все свои поля 700, 701 на предмет дополнительных данных,
  сохраните и после применения программы восстановите (да, вероятно, вручную).
  Например, в моей библиотеке сотрудники вводят поля 700^U, 701^U
  (доп. карточка) в записи ASP вручную, эти данные не переносятся из записи NJ
  (поскольку ввод этих данных в запись NJ не предусмотрен).
  
  Программа сообщит о статьях из записи NJ, для которых не будет найдено
  соответствующей записи ASP, а также о записях ASP для которых не будет
  найдено соответствующей записи NJ.
  
  Программа не учитывает записи NJP, NJK. О связанных ASP будет сообщено как о
  "сиротах". Доработка запланирована, но неприоритетна.
  
  Множественные связи записей ASP (когда в записи несколько полей 463) не
  обрабатываются, опускаются (при -v будут выводиться сообщения).
  Доработка запланирована, но неприоритетна.
  
  Варианты применения:
  1. Использовать программу как средство выявления расхождений заглавий,
  отсутствующих полях 922 или нескопированных записях ASP (с -n)
  2. После устранения ошибок запустить в режиме автокорректировки авторов
  (без -n), для устранения "проблемы 926 поля"
  3. "Пропускать" через программу входящие из корпорации файлы (без -n),
  для устранения той же "проблемы 926 поля"
  
  Поля 700, 701 будут вставлены в конец записи.
  
  (подумать над интерактивным режимом редактирования)
  
  Категория: Экспериментальные
__EOU

getopts('i:fhnv');
sub HELP_MESSAGE {print "$USAGE\n"; exit;}
sub VERSION_MESSAGE {};
HELP_MESSAGE() and exit if defined $opt_h or ! $ARGV[0];

$scriptdir = dirname(rel2abs($0));
$file = shift @ARGV;
$file = "$scriptdir/$file" unless $file =~ /^[a-z]\:/i or $file =~ /^\//;

die "No such file '$file'!\n" if ! -e $file;
if (! $opt_n) {
    die "Please specify output file!\n" if ! $ARGV[0];
    $outfile = shift @ARGV;
    $outfile = "$scriptdir/$outfile" unless $outfile =~ /^[a-z]\:/i or $outfile =~ /^\//;
    open (OUTFILE, ">", "$outfile") or die "Can't open file '$outfile': $!\n";
}
open (DBFILE, "$file") or die "Can't open file '$file': $!\n";

# Использование Tie::File для нашей задачи может показаться очень удобным, но это ОЧЕНЬ, непозволительно медленно
# Мы построим необходимые индексы и будем перемещаться по файлу "своими силами"

my @pos = (); # в массиве будут храниться позиции (они же смещения для seek) начала записей
# представим, что все записи нашего текстового файла загружены в БД
# будем стараться в print'ах использовать нумерацию записей как в этой виртуальной БД
# $pos[0] не используется и будет undef
# $pos[2] будет содержать позицию НАЧАЛА (в одном моём старом скрипте было не так) записи с MFN 2
$pos[1] = 0; # первая запись начинается с позиции ноль

my $i = 1; # тут это счётчик для вывода, первая запись имеет MFN=1
my $fcnt;  # счётчик полей, обнуляется на новой записи
my $njcnt; # просто^W счётчики, для красоты^W информативности
my $aspcnt;

while (<DBFILE>) {
    chomp;
    if ($_ eq '*****') {
        if (!($recordtype[$i])) {print "ERROR: Record $i doesn't have field 920, unable to determine record type\n";}
        elsif ($recordtype[$i] == 1) {$njcnt++}
        elsif ($recordtype[$i] == 2) {$aspcnt++}
        $fcnt = 0;
        $i++;
        $pos[$i] = tell();
        # Побочным эффектом метода будет то, что в $pos[-1] по окончании цикла будет позиция последнего разделителя.
        # И тогда утверждение "в @pos содержатся позиции начала записей" будет неверно для последнего элемента @pos.
        # Имейте это ввиду. Возможно позже я стану отрезать этот последний элемент.
        next;
    }
    if (/^\#920:/) {
        $fcnt++;
        if ($fcnt > 1) {print "ERROR: Record $i have several 920 fields, only first will be examined\n";}
        else {
            given ($_) { # нас будут интересовать только типы 1 и 2, остальные присутствуют для проверки поля на валидность
                when ("#920: NJ")     {$recordtype[$i] = 1}
                when ("#920: ASP")    {$recordtype[$i] = 2}
                when ("#920: NJP")    {$recordtype[$i] = 3}
                when ("#920: NJK")    {$recordtype[$i] = 3}
                when ("#920: J")      {$recordtype[$i] = 3}
                when ("#920: PAZK")   {$recordtype[$i] = 4}
                when ("#920: PVK")    {$recordtype[$i] = 4}
                when ("#920: SPEC")   {$recordtype[$i] = 4}
                when ("#920: AUNTD")  {$recordtype[$i] = 4}
                when ("#920: IBIS")   {$recordtype[$i] = 4}
                default {
                    $recordtype[$i] = 99;
                    print "ERROR: Record $i has unknown record type, exact data is: '$_'\n";
                }
            }
        }
    }
}

print "Found $njcnt NJ and $aspcnt ASP records\n" if $opt_v;

# Что мы делаем:
# Выделяем связь между NJ и её ASP (позиции записей БД)
# После этого выделяем связь между полями 922 и заглавиями-страницами ASP (где мы будем заменять авторов)
# В процессе мы запомним авторов для каждого поля 922 (для, естественно,
# использования их для замены, что является нашей основной задачей)

# Структуры данных:
#
# 1) (rpos)
# *ХЕШ для хранения списков NJ, ключом будет шифр номера, каждый элемент
#    хеша -- ссылка на массив:
#    *МАССИВ, в элементах которого позиции записей, МАССИВ[0] -- позиция NJ,
#     остальные элементы -- позиции ASP по порядку расположения в файле БД
#
# 2) (rrel)
# *ХЕШ для хранения списков NJ, ключом будет шифр номера (да, ещё один), каждый
#  элемент хеша -- ссылка на массив:
#     *МАССИВ (мета-массив), в котором МАССИВ[0] -- позиция NJ, остальные
#      элементы -- ссылки на хеши, порядок элементов соответствует
#      расположению полей 922 в записи NJ:
#         *ХЕШ, ключи: title (строка), pages (строка), authors (ссылка)
#          ключ authors содержит ссылку на:
#             *МАССИВ (мета-массив), содержит ссылки на хеши, порядок элементов
#              соответствует расположению полей с авторами:
#                 *ХЕШ, ключи: lastname (строка), initials (строка),
#                  firstname (строка), wcount (число), function (строка),
#                  matchcnt (число)
# 3) (aspmatch)
# *ХЕШ, ключи -- позиции (как в @pos), значения -- ссылки на:
#     *ХЕШ, ключи: matchcnt (число), title (строка), pages (строка),
#      code (строка), authors (ссылка)
#      ключ authors содержит ссылку на массив, идентичный такому в rrel
#      (и даже является просто копией его)
#
# Есть ощущение, что можно было сократить количество или пересмотреть
# качество структур, но пока нет желания перекраивать программу


# Заполним структуры данных 1 и 2 позициями NJ

$i = 1;
$fcnt = 0;
my %seen = ();
my %rpos = (); # это структура данных 1
my %rrel = (); # это структура данных 2
seek (DBFILE,0,0);
while (<DBFILE>) {
    chomp;
    my $ccode;
    if ($_ eq '*****') {
        if (($recordtype[$i] == 1) and ($fcnt == 0) and ($opt_v)) {print "ERROR: No field 903 in NJ record $i\n"}
        elsif (($fcnt > 1) and ($opt_v)) {print "ERROR: NJ record $i have several 903 fields, using only last\n"}
        $fcnt = 0;
        $i++;
        next;
    }
    if ($recordtype[$i] == 1) {
        if (/^\#903:/) {
            $fcnt++;
            my $ccode = $_;
            ($ccode = $_) =~ s/^\#903: //;
            if ($ccode ne "") {
                if (!($seen{$ccode})) {  # если такого шифра мы ещё не видели
                    $seen{$ccode} = $i;  # запомним номер записи (используется как признак и потом может пригодиться)
                    push @{ $rpos{$ccode} }, $pos[$i];
                    push @{ $rrel{$ccode} }, $pos[$i];
                    #print "RECORD $i POS $pos[$i]\n";
                }
                else {print "ERROR: Found duplicate code in record $i, exact data is: '$_', see record $seen{$ccode}, this record ignored\n"};
            }
            else {if ($opt_v) {print "WARNING: Empty 903 field in NJ record $i\n";}}
        }
    }
}

# Заполним структуру данных 1 позициями ASP, структуру 3 номерами записей ASP

$i = 1;
$fcnt = 0;
@rcodes = ();
seek (DBFILE,0,0);
while (<DBFILE>) {
    chomp;
    if ($_ eq '*****') {
        if ($fcnt > 1 and $opt_v) {print "WARNING: Multiple 463 fields in record $i. Entire record skipped.\n";} # если несколько 463
        elsif ($fcnt == 1) { # если поле 463 вообще есть
            if ($rpos{$rcodes[0]}) { # если в хеше такое есть (там должна быть позиция NJ)
                push @{ $rpos{$rcodes[0]} }, $pos[$i]; # добавить туда
            } else {
                print "ERROR: Orphaned ASP record $i with code '$rcodes[0]' (@rcodes)\n" if $opt_v; # иначе это сирота
            }
        }
        else {
            # если у нас $fcnt равен нулю, то мы не знаем, это ASP или не ASP, поэтому нужно проверять и $recordtype[$i]
            if (($opt_v) and ($recordtype[$i] == 2)) {print "WARNING: ASP record $i does not contain valid subfield ^W or entire field 463 at all\n";}
        }
        $i++;
        $fcnt = 0;
        @rcodes = ();
        next;
    }
    if ($recordtype[$i] == 2) {
        if (/^\#463:.*\^[wW]([^^]+)/) {
            push @rcodes, $1;
            $fcnt++;
        }
    }
}

# Надо заполнять структуру 2
# Мы уже знаем позиции NJ из %rrel
# Будем перемещаться по ним и просматривать поля 922, 926

sub parse_authors_922 {
    
    # Подпрограмма добавляет авторов в структуру данных 2 из полей 922
    
    # параметры:
    # 0 - поле (строка) БД
    # 1 - ссылка на структуру данных 2
    # 2 - шифр
    # 3 - номер статьи
    # 4 - номер автора
    # 5 - идентификатор подполя ФИО (без ^)
    # 6 - идентификатор подполя расширение инициалов (без ^)
    # 7 - идентификатор подполя признака инвертирования (без ^)
    # 8 - идентификатор подполя функции (без ^)
    # 9 - идентификатор подполя "Работает в данной организации?" (без ^)
    # 10 - идентификатор подполя места работы (без ^)
    
    my ($line, $ref, $code, $article_num, $author_num, $fio_field, $initexp_field, $invert_field, $func_field, $local_field, $org_field) = @_;
    
    if ($line =~ /\^[$fio_field]([^^]+)/) { # если есть поле ФИО
        my $fio = $1;
        my @split;
        
        my $firstname;      # Имя
        my $lastname;       # Фамилия
        my $initials;       # Инициалы
        my $wcount;         # Кол-во слов в фамилии (извлекается из поля "Роль ..." или автоматически присваивается в 1)
        my $role;           # Этой переменной присваивается 1, и только если в поле "Роль ..." также указано 1
        my $function;       # Функция, если не автор
        my $localauthor;    # "Работает в данной организации?"
        my $organization;   # Место работы автора
        
        # сначала надо выяснить сколько слов в фамилии
        if ($line =~ /\^[$invert_field]([^^]+)/) { # если количество слов указано
            $wcount = $1;
            if ($wcount !~ /\d+/) {die "ERROR: Non-digit value '$wcount' where digits expected (^$invert_field) in '$line'\n"}
            else {
                # Только если в поле стоит единица ирбис включит запрет инвертирования ФИО
                # В этом случае нам нужно также передать эту единицу в запись ASP
                # Для этого и используется $role
                $role = 1 if $wcount == 1;
            }
        } else {$wcount = 1} # иначе у нас одно слово в фамилии
        
        # теперь выделим фамилию
        @split = split (/\s+/, $fio); # разберём
        $lastname = shift (@split); # соберём
        if ($wcount > 1) {
            for (2..$wcount) {
                my $word = shift (@split);
                $lastname = "$lastname $word";
            }
        }
        
        # посмотрим что дальше в поле ФИО
        if ($lastname =~ /,$/) { # если заканчивается на запятую -- у нас тут расширение инициалов
            $lastname =~ s/,$//; # запятую отрезать
            $firstname = shift (@split);
            foreach (@split) {$firstname = "$firstname $_"}
        } else { # иначе у нас тут инициалы
            $initials = shift (@split);
            foreach (@split) {$initials = "$initials $_"}
        }
        
        # посмотрим что в поле расширение инициалов
        if ($line =~ /\^[$initexp_field]([^^]+)/) {
            # Если расширение инициалов было также введено в поле ФИО (методом запятой
            # и пробела) то мы перезапишем полученное из поля ФИО значение, хотя ирбис 
            # ведет себя не так. Ирбис берет расширение из "расширения", а то, что в
            # "ФИО" берёт как инициалы, и не удаляет запятую в конце фамилии.
            $firstname = $1;
        }
        
        # аналогично для "функции", "Работает ... ?" и "места работы"
        if ($line =~ /\^[$func_field]([^^]+)/) {$function = $1}
        if ($line =~ /\^[$local_field]([^^]+)/) {$localauthor = $1}
        if ($line =~ /\^[$org_field]([^^]+)/) {$organization = $1}
        
        # print "DEBUG F=> '$firstname', L=> '$lastname', I=> '$initials'\n";
        
        # сохраним всё в структуру данных
        
        
        ${$ref}{$code}[$article_num]{'authors'}[$author_num]{'firstname'} = $firstname;
        ${$ref}{$code}[$article_num]{'authors'}[$author_num]{'lastname'} = $lastname;
        ${$ref}{$code}[$article_num]{'authors'}[$author_num]{'initials'} = $initials;
        ${$ref}{$code}[$article_num]{'authors'}[$author_num]{'role'} = $role;
        ${$ref}{$code}[$article_num]{'authors'}[$author_num]{'function'} = $function;
        ${$ref}{$code}[$article_num]{'authors'}[$author_num]{'localauthor'} = $localauthor;
        ${$ref}{$code}[$article_num]{'authors'}[$author_num]{'organization'} = $organization;
    }
}

sub parse_authors_926 {
    
    # Подпрограмма добавляет авторов в структуру данных 2 из полей 926
    
    # параметры:
    # 0 - поле (строка) БД
    # 1 - ссылка на структуру данных 2
    # 2 - шифр
    
    my ($line, $ref, $code) = @_;
    
    # hardcoded
    my $lastname_field    = "A";
    my $firstname_field   = "G";
    my $initials_field    = "B";
    my $article_num_field = "!";
    
    # Остальные поля мы не обрабатываем поскольку они не являются автогенерируемыми
    
    my $firstname;      # Имя
    my $lastname;       # Фамилия
    my $initials;       # Инициалы
    my $article_num;    # Номер статьи
    
    if ($line =~ /\^[$article_num_field](\d+)/) {$article_num = $1}
    else {die "ERROR: No article number (^$article_num_field) in line '$line'\n"}
    
    if ($line =~ /\^[$lastname_field]([^^]+)/) {
        $lastname = $1;
        if ($line =~ /\^[$firstname_field]([^^]+)/) {$firstname = $1}
        if ($line =~ /\^[$initials_field]([^^]+)/)  {$initials = $1}
    }
    
    #print "926: N=> '$article_num', F=> '$firstname', L=> '$lastname', I=> '$initials'\n";
    
    # сохраним всё в структуру данных
    
    # номер статьи у нас указан в поле, и мы просто добавим в массив этой статьи
    # новый хеш, т.к. ранее мы "заняли" место в этом массиве для первых трех авторов
    
    push @{ ${$ref}{$code}[$article_num]{'authors'} }, {'firstname' => $firstname,
                                                        'lastname'  => $lastname,
                                                        'initials'  => $initials,};
    
}

for $code (keys %rrel) {
    my $article_number = 1;
    seek (DBFILE,$rrel{$code}[0],0);
    while (<DBFILE>) {
        chomp;
        if (/^\#922:/) {
            # заполнить позиции 1, 2, 3 авторов пустыми данными, позиции авторов в массиве для нас важны
            push @{ $rrel{$code}[$article_number]{'authors'} }, (+{}, +{}, +{});
            
            if (/\^[cC]([^^]+)/) {$rrel{$code}[$article_number]{'title'} = $1}
            else {print "WARNING: No title (^C) in row '$_'\n" if $opt_v;}
            
            #print "TITLE '%rrel{$code}[$article_number]{'title'}' in $_\n";
            
            if (/\^4([^^]+)/) {$rrel{$code}[$article_number]{'pages'} = $1}
            else {print "WARNING: No pages (^4) in row '$_'\n" if $opt_v;}
            
            &parse_authors_922 ($_, \%rrel, $code, $article_number, 0, "F", "?", "X", "Q", "Y", "=");
            &parse_authors_922 ($_, \%rrel, $code, $article_number, 1, "2", ",", "<", "S", "Z", "+");
            &parse_authors_922 ($_, \%rrel, $code, $article_number, 2, "3", ";", ">", "T", "N", "-");
            
            $article_number++;
        }
        last if $_ eq "*****";
    }
}

for $code (keys %rrel) {
    seek (DBFILE,$rrel{$code}[0],0);
    while (<DBFILE>) {
        chomp;
        if (/^\#926:/) {
            
            # Мы ранее оговорили что "других авторов" без первого, второго и
            # третьего быть не должно.
            # Обработка 926 (в текущей реализации) должна быть после обработки всех 922
            # Авторов из 926 мы просто push'им в массивы авторов, полагая, что место для
            # первых трёх уже занято.
            
            &parse_authors_926 ($_, \%rrel, $code);
        }
        last if $_ eq "*****";
    }
}

# Теперь нужно пройтись по записям ASP из структуры данных 1,
# сравнить их с данными из структуры 2 и вывести отличия

my %aspmatch;

for $code (keys %rpos) {
    for $i (1 .. $#{ $rpos{$code} }) { # для всех ASP
        my $pos = $rpos{$code}[$i];
        my $title;
        my $pages;
        my @authors;
        $aspmatch{$pos}{'code'} = $code;
        #print "RPOS ", $rpos{$code}[$i], "\n";
        seek (DBFILE,$pos,0);
        while (<DBFILE>) {
            chomp;
            my $line = $_;
            # РАЗБИРАЕМ ASP
            if ($line =~ /^\#200:.*\^A([^^]+)/) {$title = $1; $aspmatch{$pos}{'title'} = $title;};
            if ($line =~ /^\#463:.*\^S([^^]+)/) {$pages = $1; $aspmatch{$pos}{'pages'} = $pages;};
            if ($line =~ /^\#70[01]:/) {
                # ТВП SNT в моём 2007.1 авторов с заполненой "функцией" переносит в 700, 701 поля
                # но не в 702, как можно подумать. Поэтому 702 мы не рассматриваем.
                
                # Кстати, зачем мне этот блок?
                
                my $lastname;       # Фамилия
                my $firstname;      # Имя
                my $initials;       # Инициалы
                # my $wcount;         # Кол-во слов в фамилии (извлекается из поля "Роль ..." или автоматически присваивается в 1)
                # my $role;           # Этой переменной присваивается 1, и только если в поле "Роль ..." также указано 1
                my $function;       # Функция, если не автор
                my $localauthor;    # "Работает в данной организации?"
                my $organization;   # Место работы автора
                
                my $lastname_field      = "A";
                my $firstname_field     = "G";
                my $initials_field      = "B";
                my $function_field      = "4";
                my $localauthor_field   = "Y";
                my $organization_field  = "P";
                
                if ($line =~ /\^[$lastname_field]([^^]+)/)      {$lastname = $1};
                if ($line =~ /\^[$firstname_field]([^^]+)/)     {$firstname = $1};
                if ($line =~ /\^[$initials_field]([^^]+)/)      {$initials = $1};
                if ($line =~ /\^[$function_field]([^^]+)/)      {$function = $1};
                if ($line =~ /\^[$localauthor_field]([^^]+)/)   {$localauthor = $1};
                if ($line =~ /\^[$organization_field]([^^]+)/)  {$organization = $1};
                
                push @authors, {'firstname' => $firstname,
                                'lastname' => $lastname,
                                'initials' => $initials,
                                'function' => $function,
                                'localauthor' => $localauthor,
                                'organization' => $organization,};
            }
            if ($line eq '*****') {
                # сравниваем с %rrel
                foreach $anum (1 .. $#{ $rrel{$code} }) {
                    # print "ELEMENT $rrel{$code}[$anum]{'title'}\n";
                    if ($rrel{$code}[$anum]{'title'} eq $title and $rrel{$code}[$anum]{'pages'} eq $pages) {
                        $rrel{$code}[$anum]{'matchcnt'}++;  # отметка "для этой статьи оглавления мы нашли совпадение с записью ASP"
                        $aspmatch{$pos}{'matchcnt'}++;      # отметка "для этой записи ASP мы нашли соответствие с оглавлением"
                        $aspmatch{$pos}{'authors'} = $rrel{$code}[$anum]{'authors'}; # так будет сильно удобнее
                        #print "MATCH $title\n" if $opt_v;
                    }
                }
                last;
            }
        }
    }
}

# теперь напечатаем "расхождения"
for $code (keys %rrel) {
    foreach $i (1 .. $#{ $rrel{$code} }) {
        my $matchcnt = $rrel{$code}[$i]{'matchcnt'};
        my $title    = $rrel{$code}[$i]{'title'};
        my $pages    = $rrel{$code}[$i]{'pages'};
        if ($matchcnt < 1) {
            print "ORPHANED 922: TITLE '$title', CODE '$code', PAGES '$pages'\n" if $opt_v;
        }
        if ($matchcnt > 1) {
            print "MULTIPLE IDENTICAL ($matchcnt) 922: TITLE '$title', CODE '$code', PAGES '$pages'\n" if $opt_v;
        }
    }
}
for $idx (keys %aspmatch) {
    my $matchcnt = $aspmatch{$idx}{'matchcnt'};
    my $title    = $aspmatch{$idx}{'title'};
    my $pages    = $aspmatch{$idx}{'pages'};
    my $code     = $aspmatch{$idx}{'code'};
    if ($matchcnt < 1) {
        print "ORPHANED ASP: TITLE '$title', CODE '$code', PAGES '$pages'\n" if $opt_v;
    }
    if ($matchcnt > 1) {
        print "MULTIPLE IDENTICAL ($matchcnt) ASP: TITLE '$title', CODE '$code', PAGES '$pages'\n" if $opt_v;
    }
}

die if $opt_n;

# Теперь, если надо править БД, пройдёмся по авторам и заменим поля авторов в ASP

print "LAST POS: $pos[scalar(@pos)]\n";

foreach $i ( 1 .. scalar(@pos)-1 ) {
    seek (DBFILE,$pos[$i],0);
    while (<DBFILE>) {
        chomp;
        my $line = $_;
        # если мы знаем, что для этой позиции есть совпадение (этот признак также означает, что эта запись -- ASP)
        if ($aspmatch{$pos[$i]}{'matchcnt'} == 1) {
            next if $line =~ /^\#70[01]:/;
            if ($line eq '*****') {
                # генерируем поля 700, 701
                #print "ASPMATCH: $aspmatch{$pos[$i]}{'authors'}\n";
                for $anum (0 .. $#{ $aspmatch{$pos[$i]}{'authors'} }) {
                    
                    my $field_num;
                    my $new_line;
                    
                    my $lastname_field     = "A";
                    my $firstname_field    = "G";
                    my $initials_field     = "B";
                    my $function_field     = "4";
                    my $localauthor_field  = "Y";
                    my $organization_field = "P";
                    my $role_field         = "9"; # это та "роль", где "инвертирование ФИО"
                    
                    my $firstname    = $aspmatch{$pos[$i]}{'authors'}[$anum]{'firstname'};
                    my $lastname     = $aspmatch{$pos[$i]}{'authors'}[$anum]{'lastname'};
                    my $initials     = $aspmatch{$pos[$i]}{'authors'}[$anum]{'initials'};
                    my $function     = $aspmatch{$pos[$i]}{'authors'}[$anum]{'function'};
                    my $localauthor  = $aspmatch{$pos[$i]}{'authors'}[$anum]{'localauthor'};
                    my $organization = $aspmatch{$pos[$i]}{'authors'}[$anum]{'organization'};
                    my $role         = $aspmatch{$pos[$i]}{'authors'}[$anum]{'role'};
                    
                    if ($anum > 0) {$field_num = '701'} else {$field_num = '700'};
                    
                    $new_line = '#'."$field_num".': ';
                    
                    #print "LASTNAME: $lastname\n";
                    
                    if ($lastname) {
                        $new_line = $new_line . "^$lastname_field" . "$lastname";
                        
                        if ($firstname) {
                            $new_line = $new_line . "^$firstname_field" . "$firstname";
                        }
                        
                        if ($initials) {
                            $new_line = $new_line . "^$initials_field" . "$initials";
                        }
                        
                        if ($function) {
                            $new_line = $new_line . "^$function_field" . "$function";
                        }
                        
                        if ($localauthor) {
                            $new_line = $new_line . "^$localauthor_field" . "$localauthor";
                        }
                        
                        if ($organization) {
                            $new_line = $new_line . "^$organization_field" . "$organization";
                        }
                        
                        if ($role) {
                            $new_line = $new_line . "^$role_field" . "$role";
                        }
                        
                        print OUTFILE "$new_line\n";
                    }
                }
                print OUTFILE "*****\n";
                last;
            }
            print OUTFILE "$line\n";
        }
        else {print OUTFILE "$line\n";} # иначе вывести как есть
        last if $line eq '*****';
    }
}

#print "DUMPER\n", Dumper(\%rrel);
