obsah_init.pl

   1 #! /usr/bin/perl
   2 #
   3 #       $Id$
   4
   5 use strict;
   6 use DBI;
   7
   8 use vars qw/$db_driver $db_host $db_user $db_pwd $DB_PWD $db_name $db/;
   9 use vars qw/$tb_obsah $tb_clanek/;
  10
  11 $db_driver="mysql";
  12 $db_host="";
  13 $db_user="short";
  14 $DB_PWD=$ENV{"HOME"}."/priv/mysql.${db_user}.pwd";
  15 $db_name="short";
  16 $tb_obsah="energie_obsah";
  17 $tb_clanek="energie_clanek";
  18
  19 open DB_PWD or die "Failed open \"$DB_PWD\": $!";
  20 $db_pwd=<DB_PWD>;
  21 chomp $db_pwd;
  22 close DB_PWD;
  23
  24 $db=DBI->connect("DBI:$db_driver:database=$db_name;host=$db_host",$db_user,$db_pwd) or die "Database open fail: $!";
  25
  26 sub db_do
  27 {
  28 my( $cmd )=@_;
  29
  30         $db->do($cmd) or die("SQL command \"$cmd\" failed: $!");
  31 }
  32
  33 eval { &db_do("drop table $tb_obsah") };
  34
  35 &db_do("create table $tb_obsah ("
  36                 ."year year(4) not null,"
  37                 ."month tinyint not null,"
  38                 ."month_last tinyint not null,"
  39                 ."sequential smallint not null,"
  40                 ."contents text null"
  41                 .")");
  42
  43 &db_do("alter table $tb_obsah add unique (year,month)");
  44
  45 eval { &db_do("drop table $tb_clanek") };
  46
  47 &db_do("create table $tb_clanek ("
  48                 ."year year(4) not null,"
  49                 ."month tinyint not null,"
  50                 ."id tinyint not null,"
  51                 ."name text not null,"
  52                 ."contents text not null"
  53                 .")");
  54
  55 &db_do("alter table $tb_clanek add unique (year,month,id)");
  56
  57 use vars qw/$insert_tb_obsah $insert_tb_clanek $year $month $month_last $sequential $contents $first $article_id/;
  58
  59 sub where
  60 {
  61         return " in file $ARGV on line $.";
  62 }
  63
  64 sub flush_month
  65 {
  66         $_=$contents;
  67         return if !defined $_;
  68         if (!$_) {
  69                 # Permitted to show just the title image
  70                 #print("Empty contents".&where()."!\n");
  71                 }
  72         else {
  73                 tr/ \t\n/  \n/s;
  74                 s/([\001\n]) | ([\002\n])/$1$2/g;
  75                 die "Page marker not found somewhere in this month".&where() if (/^[^\004]*\001[^\003\004]*\002/);
  76                 die "Duplicate page markers in this month".&where() if (/strana /);
  77                 tr/\002//d;
  78                 $_=substr($_,1);
  79                 }
  80         $insert_tb_obsah->execute($year,$month,$month_last,$sequential,($_ || undef())) or die "SQL insert failure: $!";
  81         undef $year,$month;
  82         undef $contents;
  83         undef $first;
  84         undef $article_id;
  85 }
  86
  87 $insert_tb_obsah=$db->prepare("insert into $tb_obsah (year,month,month_last,sequential,contents) values (?,?,?,?,?)")
  88                 or die "Prepare fail: $!";
  89 $insert_tb_clanek=$db->prepare("insert into $tb_clanek (year,month,id,name,contents) values (?,?,?,?,?)")
  90                 or die "Prepare fail: $!";
  91
  92 while (<>) {
  93         chomp;
  94         if (m#^EaP (\d+)(-(\d+))?/(\d+) \((\d+)(-\d+)?\)$#) {
  95                 &flush_month();
  96                 $month=$1;
  97                 $month_last=($3 ? $3 : $1);
  98                 $year =$4;
  99                 $sequential=$5;
 100                 $contents="";
 101                 next;
 102                 }
 103         if (/^#(.+)$/) {
 104 my( $clanek )="";
 105 my( $line );
 106                 while (($line=<>)!~/^#$/) {
 107                         die "Article EOF marker not found".&where() if (!$line);
 108                         $clanek.=$line;
 109                         }
 110                 # $article_id probably should not be zero
 111                 $insert_tb_clanek->execute($year,$month,++$article_id,$1,$clanek) or die "SQL insert failure: $!";
 112                 next;
 113                 }
 114         if (/^Pøíloha:$/) {
 115                 die "Multiple \"Pøíloha\"s".&where() if ($contents=~/\004/);
 116                 $contents.="\004";
 117                 next;
 118                 }
 119         if (/^[^ \t]/ || (/^\s/ && $contents=~/\004/)) {
 120                 $contents.="\001$_\002";
 121                 $first=$_;
 122                 next;
 123                 }
 124         if (/^\s+strana \.\.\. ([\d ,-]+)$/) {
 125                 die "Page number without start".&where() if ("\002"!=substr($contents,-1,1));
 126                 die "Page number already specified".&where() if ($contents=~/\003[^\001\002\004]*\002$/);
 127                 $contents=substr($contents,0,-1)."\003$1\002";
 128                 next;
 129                 }
 130         if (/^\s(.*)$/) {
 131                 my( $s )=$1;
 132                 die "INTERNAL: continuation for \"Pøíloha\"".&where() if ($contents=~/\004/);
 133                 die "Continuation contents without start".&where() if ("\002"!=substr($contents,-1,1));
 134                 if ($contents=~/\003[^\001\002\004]*\002$/) {
 135                         die "First line not found".&where() if !defined($first);
 136                         $contents.="\001$first\002";
 137                         }
 138                 $contents=substr($contents,0,-1)."\n$s\002";
 139                 next;
 140                 }
 141         die "Unexpected text".&where().": $_" if (/\S/);
 142         }
 143 &flush_month();
 144
 145 print("success.\n");