[BACK]Return to makeauthors.pl CVS log [TXT] [DIR] Up to [Local Repository] / db / prgsrc

Diff for /db/prgsrc/makeauthors.pl between versions 1.3 and 1.10

version 1.3, 2003/01/09 01:43:21 version 1.10, 2010/09/24 16:58:57
Line 1 Line 1
   #!/usr/bin/perl -w
 #!/usr/local/bin/perl -w  
   
 =head1 NAME  =head1 NAME
   
Line 45  open STDERR, ">$DUMPDIR/errors"; Line 44  open STDERR, ">$DUMPDIR/errors";
   
   
   
         mydo("DROP TABLE IF EXISTS Authors");  
 mydo("CREATE TABLE Authors  
 (  
                 Id     INT NOT NULL PRIMARY KEY AUTO_INCREMENT,  
                             KEY idkey (Id),  
                 CharId     CHAR(20),  
                 Name   CHAR(50),  
                 Surname CHAR(50),  
                 Nicks TEXT,  
                 QNumber INT  
 )");  
   
 mydo ("DROP TABLE IF EXISTS A2Q");  
 mydo("CREATE TABLE A2Q  
 (  
                 Id  INT NOT NULL PRIMARY KEY AUTO_INCREMENT,  
                 Author INT UNSIGNED ,  
                 Question INT UNSIGNED   
 )  
   
              "  
             );  
   
   
 while (<NICKS>)  while (<NICKS>)
 {  {
    ($number,$nick)=split;     ($number,$nick)=split;   
      next unless $number;   
    next unless $number=~/^\d+$/;     next unless $number=~/^\d+$/;
    ($name,$surname)=split ' ',<NICKS>;     @parts = split ' ',<NICKS>;
    $name{$nick}= ucfirst lc $name;     $_ = ucfirst lc $_ foreach  @parts;
    $surname=ucfirst lc $surname;     $surname = pop @parts;
      my $name;
      $name = $name{$nick}= join ' ', @parts;
    $surname=~s/\-(.)/"-". uc $1/ge;     $surname=~s/\-(.)/"-". uc $1/ge;
      $surname=~s/\'(.)/"'". uc $1/ge;
    $surname{$nick}= $surname;     $surname{$nick}= $surname;
         $sn = "$name $surname";
   print "$name!$surname\n";
      $sn =~ tr/Ёё/Ее/;
      $nickfromname{uc $sn} = $nick;   
 }  }
   
 $surname{'error'}='Глюков';  $surname{'error'}='Глюков';
 $name{'error'}='Очепят';  $name{'error'}='Очепят';
 $surname{'unknown'}='Неизвестный';  $surname{'unknown'}='Неизвестный';
 $name{'unknown'}='Псевдоним';  $name{'unknown'}='Псевдоним';
 $surname{'team'}='Капитанова';  $surname{'team'}='Авторов';
 $name{'team'}='Команда_';  $name{'team'}='Коллектив';
   
   
 while (<SSNICKS>)  while (<SSNICKS>)
Line 99  while (<SSNICKS>) Line 82  while (<SSNICKS>)
    $ssnick{$nick}.="|$str";     $ssnick{$nick}.="|$str";
 }  }
   
   
 close (NICKS);  close (NICKS);
 close (SSNICKS);  close (SSNICKS);
   
   
   
 open AUTHORS,"<$authorsfile" or die "Can not open authors";  open AUTHORS,"<$authorsfile" or die "Can not open authors";
   print "REading authors...\n";
 while (<AUTHORS>)  while (<AUTHORS>)
 {  {
   
    ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;     ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
    if (!$nick)      if (!$nick) 
    {     {
       ($number,$descr)=m/^(\d+)\s+(.*)$/g;        ($number,$descr)=m/^(\d+)\s+(.*)$/g;
       $nick='unknown';        $nick='unknown';
    }     }
    $nick=~s/\s*$//;  #   if ($nick=~s/\s*$//)
    $descr=~s/([\.\,\:\!\?])/$1 /g;     $descr=~s/([\.\,\:\!\?])/$1 /g;
    $descr=~s/\\n/ /g;     $descr=~s/\\n/ /g;
    $descr=~s/^\s+//g;     $descr=~s/^\s+//g;
Line 131  while (<AUTHORS>) Line 112  while (<AUTHORS>)
    }     }
 }  }
   
   print "printing unknown...\n";
 foreach $as(keys %unknick)  foreach $as(keys %unknick)
 {  {
     print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));      print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
     print UNICKS "\n";      print UNICKS "\n";
 }  }
   
 %forbidden=checktable('equalto')? getequalto : ();  %forbidden=tableexists('equalto')? getequalto : ();
   
 #print scalar keys %forbidden, "forbidden questions\n";  #print scalar keys %forbidden, "forbidden questions\n";
   
 getbase('QuestionId','Authors');  getbase('QuestionId','Authors');
   
 while (($QuestionId, $author)=getrow,$QuestionId)  while (($QuestionId, $author)=getrow,$QuestionId)
 {  {
      print "." unless $i++ % 100;
    next unless $author;     next unless $author;
    $author=~s/([\.\,\:\!\?])/$1 /gm;     $author=~s/([\.\,\:\!\?])/$1 /gm;
    $author=~s/^\s+//mg;     $author=~s/^\s+//mg;
Line 153  while (($QuestionId, $author)=getrow,$Qu Line 134  while (($QuestionId, $author)=getrow,$Qu
    $author=~s/\s+$//mg;     $author=~s/\s+$//mg;
    $author=~s/\s+/ /mg;     $author=~s/\s+/ /mg;
    $author=uc $author;     $author=uc $author;
      $author=~s/ё/е/mg;
    if ($nick = $nick{$author})      if ($nick = $nick{$author}) 
    {      { 
       my @a=split ' ',$nick;        my @a=split ' ',$nick;
    foreach $tmp(@a) {
      if ($tmp eq '!!!') {
        print STDERR "!$author!".$QuestionId."\n";
      }
    }
       push @{$questions{$_}},$QuestionId foreach @a;        push @{$questions{$_}},$QuestionId foreach @a;
    }     }
    else      else 
Line 171  print scalar keys %nick , " authors foun Line 157  print scalar keys %nick , " authors foun
   
   
 #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;  #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
   addquestions2author($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions;
 addauthors($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions;  
   
 print UNKNOWN "$_\n" foreach sort keys %unknown;  print UNKNOWN "$_\n" foreach sort keys %unknown;
Removed from v.1.3  
changed lines
  Added in v.1.10

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>