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

Diff for /db/prgsrc/dbchgk.pm between versions 1.2 and 1.10

version 1.2, 2001/10/31 03:07:18 version 1.10, 2005/07/05 23:58:10
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   
   =head1 NAME
   
   dbchgk.pm - модуль для работы с базой
   
   =head1 SYNOPSIS
   
     use chgkfiles.pm  
   
   =head1 DESCRIPTION
   
     Работа с базой
   
   
   =head1 AUTHOR
   
   Роман Семизаров
   =cut
   
 package dbchgk;  package dbchgk;
 use DBI;  use DBI;
 use Exporter;  use Exporter;
Line 6  use vars qw(@ISA @EXPORT); Line 25  use vars qw(@ISA @EXPORT);
 @ISA=qw(Exporter);  @ISA=qw(Exporter);
   
 @EXPORT = qw(&getbase &getquestions &closebase &getrow $z &in2out &getall &addnf &out2in &mydo  @EXPORT = qw(&getbase &getquestions &closebase &getrow $z &in2out &getall &addnf &out2in &mydo
              &getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task &cformula               &getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task 
              &updateword2question &knownword &incnf &searchmark &knownnf &getnests                &updateword2question &knownword &incnf &searchmark &knownnf &getnests 
              &packword &getnfnumbers &getword2question) ;               &packword &getnfnumbers &getword2question &addauthors) ;
   
 my $z;  my $z;
 my $qbase;  my $qbase;
Line 94  sub addword2task Line 113  sub addword2task
   $qbase -> do("insert into word2question (word,questions) values ($w1,$w2)");    $qbase -> do("insert into word2question (word,questions) values ($w1,$w2)");
 }  }
   
   sub addauthors
   {
     my ($charid,$name,$surname,$questions,$nicks,$forbidden)=@_;
     $_=$qbase -> 
         quote($_)  foreach ($charid,$name,$surname,$nicks);
     my $kvo=scalar grep {!$$forbidden{$_}} @$questions;
   my $query="insert into Authors (CharId,name,surname,QNumber,Nicks) 
                   values ($charid,$name,$surname,".$kvo.",$nicks)";
   
    print $query if $debug;
   
     $qbase -> do($query);
    $query="select id from Authors where CharId=$charid";
    print $query if $debug;
     my $z= $qbase -> prepare($query);
     $z -> execute;
     my @ar=$z->fetchrow;
     my $id=$ar[0];
   
   
   
   foreach my $q (@{$questions})
   {
     $query="insert into A2Q (Author,Question) 
                   values ($id,$q)";
    print $query if $debug;
     $qbase -> do($query) ;
   }
   }
   
   
 sub packword  sub packword
 {  {
   my ($fieldnumber,$id,$wordnumber)=@_;    my ($fieldnumber,$id,$wordnumber)=@_;
 die "packword: fieldnumber is $fieldnumber! -- id=$id, word=$wordnumber\n" if $fieldnumber>6;  die "packword: fieldnumber is $fieldnumber! -- id=$id, word=$wordnumber\n" if $fieldnumber>6;
   pack("CSC",$fieldnumber,$id,$wordnumber%256)    $r=pack("CSC",$fieldnumber|(($id >> 16) << 4),$id%65536,$wordnumber%256);
 }  }
   
 sub updateword2question  sub updateword2question
Line 271  sub forbidden Line 321  sub forbidden
 sub checktable # если $param='delete' удаляет существующую таблицу,  sub checktable # если $param='delete' удаляет существующую таблицу,
                # если $param='ask' спрашивает, не удалить ли                 # если $param='ask' спрашивает, не удалить ли
                # если $param не определено -- просто удаляет.                 # если $param не определено -- просто удаляет.
                  # если $param='deletedata' -- удаляет из таблицы данные
 {  {
         my ($TabName,$param) = @_;          my ($TabName,$param) = @_;
         my ($ans);          my ($ans);
         if (scalar(grep(/^$TabName$/i, &tablelist))) {          if (scalar(grep(/\`$TabName$\`/i, &tablelist))) {
                 return 1 unless $param;                  return 1 unless $param;
                 if ($param eq 'delete') {$ans='y';}                  if ($param =~ /delete/) {$ans='y';}
                    else {                     else {
                            print "Table $TabName exists. Do you want to delete it? ";                             print "Table $TabName exists. Do you want to delete it? ";
                            $ans = <STDIN>                             $ans = <STDIN>
                         }                          }
                 if ($ans =~ /[yY]/) {                  if ($ans =~ /[yY]/) {
                       if ($param eq 'delete') {
                         $qbase->do("DROP TABLE $TabName");                          $qbase->do("DROP TABLE $TabName");
                         print "deleted table $TabName\n";                          print "deleted table $TabName\n";
                         return 0;                      } else {
                           $qbase->do("DELETE FROM $TabName");
                           print "Deleted everything from $TabName\n";
                       }
                       return 0;
                 } else {                  } else {
                         return 1                          return 1
                 }                  }
Line 294  sub checktable # если $param='delete' уд Line 350  sub checktable # если $param='delete' уд
   
 sub tablelist  sub tablelist
 {  {
      $qbase->func( '_ListTables' );      return $qbase->func('_ListTables');
 }  }
   
 sub in2out  sub in2out
Removed from v.1.2  
changed lines
  Added in v.1.10

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