Back to home page

Project CMSSW displayed by LXR

 
 

    


File indexing completed on 2021-02-14 13:31:54

0001 #!/usr/bin/perl
0002 
0003 use warnings;
0004 use strict;
0005 
0006 use DBI;
0007 use DBD::Oracle qw(:ora_types);
0008 
0009 package CondDB::Oracle;
0010 
0011 our $MAXNAME = 32;
0012 
0013 # creates a new database interface
0014 sub new {
0015   my $proto = shift;
0016   my $class = ref($proto) || $proto;
0017   my $this = {};
0018 
0019   $this->{counter} = 0;
0020   $this->{max_cnt} = 100;
0021 
0022   my %args = @_;
0023   $this->{check_overlap} = 1;
0024 
0025   bless($this, $class);
0026   return $this;
0027 }
0028 
0029 sub DESTROY {
0030   my $this = shift;
0031   if ($this->{transaction}) {
0032     $this->commit();
0033   }
0034 
0035   foreach (keys %{$this->{prepared}}) {
0036     $this->{prepared}->{$_}->finish();
0037   }
0038 
0039   foreach (keys %{$this->{prepared_overlap}}) {
0040     $this->{prepared_overlap}->{$_}->finish();
0041   }
0042 
0043   $this->{dbh}->disconnect() if defined $this->{dbh};
0044 }
0045 
0046 sub set_option {
0047   my $this = shift;
0048   my %args = @_;
0049 
0050   if (exists $args{-check_overlap}) {
0051     $this->{check_overlap} = !!$args{-check_overlap};
0052   }
0053 }
0054 
0055 sub connect {
0056   my $this = shift;
0057   my %args = @_;
0058   my $host = $args{-host};
0059   my $user = $args{-user};
0060   my $pass = $args{-pass};
0061   my $port = $args{-port} || 1521;
0062   my $db_opts = $args{-db_opts};
0063 
0064   unless ($host) {
0065     die "ERROR:  Must give at least host to connect():, $!"
0066   }
0067 
0068   my $db = $args{-db};
0069 
0070   # here we use the TNS_ADMIN file and $db is the SID
0071   my $dsn;
0072   if ($db) {
0073     $dsn = "DBI:Oracle:$db";
0074   } else {
0075     die "Oracle needs to have database defined on connection!\n";
0076   }
0077 
0078   my $dbh = DBI->connect($dsn, $user, $pass, $db_opts)
0079     or die "Database connection failed, $DBI::errstr";
0080 
0081   $dbh->do(qq[ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS']);
0082 
0083   $this->{host} = $host;
0084   $this->{user} = $user;
0085   $this->{db} = $db;
0086   $this->{db_opts} = $db_opts;
0087   $this->{dbh} = $dbh;
0088 
0089   return 1;
0090 }
0091 
0092 sub begin_work {
0093   my $this = shift;
0094   $this->{dbh}->begin_work();
0095   $this->{transaction} = 1;
0096 }
0097 
0098 sub commit {
0099   my $this = shift;
0100   $this->{dbh}->commit();
0101   $this->{transaction} = 0;
0102 }
0103 
0104 sub rollback {
0105   my $this = shift;
0106   $this->{dbh}->rollback();
0107   $this->{transaction} = 0;
0108 }
0109 
0110 # creates and uses a new database
0111 sub newdb {
0112   my $this = shift;
0113   my $dbh = $this->ensure_connect();
0114 
0115   my %args = @_;
0116   my $name = $args{-name} or die "ERROR:  Must give name to newdb(), $!";
0117   my $ix_tablespace = $this->{ix_tablespace};
0118 
0119   my $sql;
0120 
0121   $sql =<<END_SQL;
0122 CREATE TABLE conditionDescription (
0123   name VARCHAR2($MAXNAME) NOT NULL,
0124   description VARCHAR2(4000),
0125   units VARCHAR2(255) DEFAULT NULL,
0126   datatype CHAR(1) NOT NULL,
0127   datasize NUMBER DEFAULT '1' NOT NULL,
0128   hasError NUMBER DEFAULT '0' NOT NULL
0129 )
0130 END_SQL
0131   $dbh->do($sql);
0132 
0133   $sql = qq[ALTER TABLE conditionDescription ADD CONSTRAINT c_desc_pk
0134             PRIMARY KEY (name)];
0135   $sql .= " USING INDEX TABLESPACE $ix_tablespace" if $ix_tablespace;
0136   $dbh->do($sql);
0137 
0138 $sql =<<END_SQL;
0139 CREATE TABLE conditionColumns (
0140   name VARCHAR2($MAXNAME) NOT NULL,
0141   colindex NUMBER NOT NULL,
0142   colname VARCHAR2(64)
0143 )
0144 END_SQL
0145   $dbh->do($sql);
0146 
0147   $sql = qq[ALTER TABLE conditionColumns ADD CONSTRAINT c_cols_pk
0148             PRIMARY KEY (name, colindex)];
0149   $sql .= " USING INDEX TABLESPACE $ix_tablespace" if $ix_tablespace;
0150   $dbh->do($sql);
0151 
0152   $sql =<<END_SQL;
0153 CREATE TABLE viewDescription (
0154   name VARCHAR2($MAXNAME) NOT NULL,
0155   description VARCHAR2(4000),
0156   id1name VARCHAR2($MAXNAME) DEFAULT NULL,
0157   id2name VARCHAR2($MAXNAME) DEFAULT NULL,
0158   id3name VARCHAR2($MAXNAME) DEFAULT NULL
0159 )
0160 END_SQL
0161 
0162   $dbh->do($sql);
0163 
0164   $sql = qq[ALTER TABLE viewDescription ADD CONSTRAINT cvd_pk
0165             PRIMARY KEY (name)];
0166   $sql .= " USING INDEX TABLESPACE $ix_tablespace" if $ix_tablespace;  
0167   $dbh->do($sql);
0168 
0169   $sql =<<END_SQL;
0170 CREATE TABLE channelView (
0171   name VARCHAR2($MAXNAME) NOT NULL,
0172   id1 NUMBER DEFAULT NULL,
0173   id2 NUMBER DEFAULT NULL,
0174   id3 NUMBER DEFAULT NULL,
0175   maps_to VARCHAR2($MAXNAME) NOT NULL,
0176   logic_id NUMBER NOT NULL
0177 )
0178 END_SQL
0179   $dbh->do($sql);
0180 
0181   $sql = qq[ALTER TABLE channelView ADD CONSTRAINT cv_ix1
0182             UNIQUE (name, id1, id2, id3, logic_id)];
0183   $sql .= " USING INDEX TABLESPACE $ix_tablespace" if $ix_tablespace;
0184   $dbh->do($sql);
0185 
0186   $sql = qq[CREATE INDEX cv_ix2 ON channelView (maps_to)];
0187   $sql .= " TABLESPACE $ix_tablespace" if $ix_tablespace;
0188   $dbh->do($sql);
0189 
0190   $sql = qq[CREATE INDEX cv_ix3 ON channelView (logic_id)];
0191   $sql .= " TABLESPACE $ix_tablespace" if $ix_tablespace;
0192   $dbh->do($sql);
0193 
0194 $sql = <<END_SQL;
0195 CREATE TABLE runs (
0196   run_number NUMBER,
0197   since DATE,
0198   till DATE,
0199   status NUMBER(1) DEFAULT 1,
0200   comments VARCHAR2(4000)
0201 )
0202 END_SQL
0203 
0204   $dbh->do($sql);
0205 
0206   $sql = qq[ALTER TABLE runs ADD CONSTRAINT runs_pk
0207             PRIMARY KEY (run_number)];
0208   $sql .= " USING INDEX TABLESPACE $ix_tablespace" if $ix_tablespace;  
0209   $dbh->do($sql);
0210 
0211 
0212   $sql = qq[CREATE INDEX run_ix ON runs (since, till)];
0213   $sql .= " TABLESPACE $ix_tablespace" if $ix_tablespace;
0214   $dbh->do($sql);
0215 
0216   $this->{db} = $name;
0217   return 1;
0218 }
0219 
0220 # drop a database
0221 sub destroydb {
0222   my $this = shift;
0223   my $dbh = $this->ensure_connect();
0224 
0225   my %args = @_;
0226   my $name = $args{-name} or die "Must give name to newdb(), $!";
0227 
0228   my @tables = qw(conditionDescription conditionColumns viewDescription channelView runs);
0229   @tables = map uc, @tables;
0230   my $table_list = join ',', map "\'$_\'", @tables;
0231   my $sql = qq[ SELECT table_name FROM user_tables WHERE table_name
0232                 IN ($table_list)
0233                 OR table_name LIKE 'COND_%'
0234                 OR table_name LIKE 'CNDC_%' ];
0235   @tables = @{$dbh->selectcol_arrayref($sql)};
0236 
0237   foreach (@tables) {
0238     $dbh->do( qq[ DROP TABLE $_ ]);
0239   }
0240   return 1;
0241 }
0242 
0243 # define a stored procedure from the code in an SQL file
0244 sub define_procedure {
0245   my $this = shift;
0246   my $dbh = $this->ensure_connect();
0247 
0248   my %args = @_;
0249   my $file = $args{-file} or die "Must give file to define_procedure, $!";
0250   
0251   open FILE, '<', $file or die $!;
0252   my $code = join("", grep( $_ !~ /^\/$/, <FILE>));
0253 
0254   $dbh->do($code);
0255   
0256   close FILE;
0257 
0258   return 1;
0259 }
0260 
0261 # TODO:  is it possible to switch tablespaces?
0262 # choose the database to use
0263 sub selectdb {
0264 #   my $this = shift;
0265 #   my $dbh = $this->ensure_connect();
0266 
0267 #   my %args = @_;
0268 #   my $name = $args{-name} or die "Must give name to newdb(), $!";
0269 
0270 #   $dbh->do(qq[ USE $name ]);
0271   die "selectdb not supported by Oracle.\n";
0272 }
0273 
0274 
0275 # delete existing view if it exists and create view in DB
0276 sub new_channelView_type {
0277   my $this = shift;
0278   my $dbh = $this->ensure_connect();
0279 
0280   my %args = @_;
0281   my $name = $args{-name};
0282   my $description = $args{-description};
0283   my ($id1name, $id2name, $id3name) = @{$args{-idnames}};
0284   my $maps_to = $args{-maps_to};
0285 
0286   $maps_to = $name unless $maps_to;
0287 
0288   check_names($name, $id1name, $id2name, $id3name, $maps_to);
0289 
0290   my $sql;
0291   { no warnings;
0292     $sql = qq[ DELETE FROM channelView 
0293                  WHERE name='$name' AND maps_to='$maps_to' ];
0294     $sql =~ s/\"\"/NULL/g;
0295   }
0296   $dbh->do($sql);
0297 
0298   if ($name eq $maps_to) {
0299     { no warnings;
0300       $sql = qq[ DELETE FROM viewDescription WHERE name='$name' ];
0301       $sql =~ s/\"\"/NULL/g;
0302     }
0303     $dbh->do($sql);
0304   }
0305 
0306   { no warnings;
0307     my $fieldlist = join ',', qw(name description id1name id2name id3name);
0308     my $valuelist = join ',', map "\'$_\'", ($name, $description, $id1name,
0309                          $id2name, $id3name);
0310     $sql = qq[ INSERT INTO viewDescription ($fieldlist)
0311                  VALUES ($valuelist) ];
0312     $sql =~ s/\'\'/NULL/g;
0313   }
0314   $dbh->do($sql);
0315 
0316   return 1;
0317 }
0318 
0319 # standard data table
0320 sub new_cond_type {
0321   my $this = shift;
0322   my $dbh = $this->ensure_connect();
0323 
0324   my %args = @_;
0325   my $name = $args{-name} or die "ERROR:  -name required, $!";
0326   my $description = $args{-description};
0327   my $datasize = $args{-datasize};
0328   my $units = $args{-units};
0329   my $datatype = $args{-datatype} or die "ERROR:  -datatype required, $!";
0330   my $hasError = $args{-hasError};
0331   my $datalist = $args{-datalist};
0332   my $ddl = $args{-ddl};
0333 
0334   my $ix_tablespace = $this->{ix_tablespace};
0335 
0336   $name = "COND_".$name unless $name =~ /^COND_/;
0337   check_names($name);
0338 
0339   $datasize = 1 unless defined $datasize;
0340   $hasError = 0 unless defined $hasError;
0341 
0342   if ($datasize < 1 || $datasize >= 100) {
0343     die "ERROR:  datasize is out of range [1, 99], $!\n";
0344   }
0345 
0346   my $oracletype;
0347   if ($datatype =~ /float/) {
0348     $datatype = "f";
0349     $oracletype = "NUMBER";
0350   } elsif ($datatype =~ /int/) {
0351     $datatype = "i";
0352     $oracletype = "NUMBER";
0353   } elsif ($datatype =~ /string/) {
0354     $datatype = "s";
0355     $oracletype = "VARCHAR2(255)";
0356   } else {
0357     die "ERROR:  unknown datatype, $!";
0358   }
0359 
0360   my $sql;
0361   
0362   # drop the condition type
0363   $this->drop_condition_type(-name=>$name);
0364 
0365   # create new condition tables and information
0366   { no warnings;
0367 #     $sql = qq[ CREATE TABLE $name ( logic_id NUMBER NOT NULL,
0368 #                                     since DATE NOT NULL,
0369 #                                     till DATE DEFAULT to_date('9999-12-31 23:59:59', 'YYYY-MM-DD HH24:MI:SS') NOT NULL,];
0370     $sql = qq[ CREATE TABLE $name ( logic_id NUMBER NOT NULL,
0371                                     since NUMBER NOT NULL,
0372                                     till NUMBER DEFAULT 9999999999999999 NOT NULL,];
0373     if (!$hasError) {
0374       for (0..$datasize-1) {
0375     $sql .= sprintf "value%02d $oracletype,", $_;
0376       }
0377     } else {
0378       for (0..$datasize-1) {
0379     $sql .= sprintf "value%02d $oracletype, error%02d $oracletype,", $_, $_;
0380       }
0381     }
0382     chop $sql;
0383     $sql .= ")";
0384   }
0385   $dbh->do($sql);
0386   $ddl = $sql if $ddl;
0387 
0388   # make indexes
0389   my $keyname = $name;
0390   $keyname =~ s/COND_/C_/i;
0391 
0392   $sql = qq[ALTER TABLE ${name} ADD CONSTRAINT ${keyname}_pk
0393             PRIMARY KEY (logic_id, since, till)];
0394   $sql .= " USING INDEX TABLESPACE $ix_tablespace" if $ix_tablespace;
0395   $dbh->do($sql);
0396 
0397   $sql = qq[CREATE INDEX ${keyname}_ix ON ${name} (since, till)];
0398   $sql .= " TABLESPACE $ix_tablespace" if $ix_tablespace;
0399   $dbh->do($sql);
0400 
0401   # write metadata
0402   $this->insert_conditionDescription($name, $description, $units, $datatype,
0403                      $datasize, $hasError, $datalist);
0404 
0405   if ($ddl) { return $ddl; }
0406   else { return 1; }
0407 }
0408 
0409 
0410 # CLOB type data tables
0411 sub new_cndc_type {
0412   my $this = shift;
0413   my $dbh = $this->ensure_connect();
0414 
0415   my %args = @_;
0416   my $name = $args{-name} or die "ERROR:  -name required, $!";
0417   my $description = $args{-description};
0418   my $datasize = $args{-datasize};
0419   my $units = $args{-units};
0420   my $datatype = $args{-datatype} or die "ERROR:  -datatype required, $!";
0421   my $hasError = $args{-hasError};
0422   my $datalist = $args{-datalist};
0423   my $ddl = $args{-ddl};
0424 
0425   my $ix_tablespace = $this->{ix_tablespace};
0426 
0427   $name = "CNDC_".$name unless $name =~ /^CNDC_/;
0428   check_names($name);
0429 
0430   $datasize = 1 unless defined $datasize;
0431   defined $hasError ? $hasError = 1 : $hasError = 0;
0432 
0433   if ($datatype =~ /float/) {
0434     $datatype = "f";
0435   } elsif ($datatype =~ /int/) {
0436     $datatype = "i";
0437   } elsif ($datatype =~ /string/) {
0438     $datatype = "s";
0439   } else {
0440     die "ERROR:  unknown datatype, $!";
0441   }
0442 
0443 
0444 
0445   my $sql;
0446   # delete existing condition tables and information if it exists
0447   $this->drop_condition_type(-name=>$name);
0448 
0449   # create new condition tables and information
0450   # TODO:  require since and till NOT NULL
0451   { no warnings;
0452     $sql = qq[ CREATE TABLE $name ( since DATE NOT NULL,
0453                                     till DATE NOT NULL,
0454                                     data CLOB ) ];
0455   }
0456   $dbh->do($sql);
0457   $ddl = $sql if $ddl;
0458 
0459   # make indexes
0460   my $keyname = $name;
0461   $keyname =~ s/COND_/C_/i;
0462 
0463   $sql = qq[ALTER TABLE ${name} ADD CONSTRAINT ${keyname}_pk
0464             PRIMARY KEY (since, till)];
0465   $sql .= " USING INDEX TABLESPACE $ix_tablespace" if $ix_tablespace;
0466   $dbh->do($sql);
0467 
0468   # make IoV update trigger
0469   my $trigname = $keyname.'_tg';
0470   $sql = qq[CREATE OR REPLACE TRIGGER $trigname
0471         BEFORE INSERT ON $name
0472         REFERENCING NEW AS newiov
0473         FOR EACH ROW
0474         CALL update_online_cndc_iov('$name', :newiov.since, :newiov.till)];
0475   $dbh->do($sql);
0476 
0477   # make metadata
0478   $this->insert_conditionDescription($name, $description, $units, $datatype,
0479                      $datasize, $hasError, $datalist);
0480 
0481   if ($ddl) { return $ddl; }
0482   else { return 1; }
0483 }
0484 
0485 # delete existing condition tables and information if it exists
0486 sub drop_condition_type {
0487   my $this = shift;
0488   my $dbh = $this->ensure_connect();
0489 
0490   my %args = @_;
0491   my $name = $args{-name} or die "drop_condition_type requires -name";
0492 
0493   my $sql;
0494   { no warnings;
0495     $sql = qq[ DROP TABLE $name ];
0496     $dbh->do($sql) if $this->table_exists($name);
0497   }
0498 
0499   { no warnings;
0500     $sql = qq[ DELETE FROM conditionDescription WHERE name='$name' ];
0501   }
0502   $dbh->do($sql);
0503 
0504   { no warnings;
0505     $sql = qq[ DELETE FROM conditionColumns WHERE name='$name' ];
0506   }
0507   $dbh->do($sql);
0508 
0509   return 1;
0510 }
0511 
0512 
0513 # metadata for data tables
0514 sub insert_conditionDescription {
0515   my $this = shift;
0516   my $dbh = $this->ensure_connect();
0517 
0518   my ($name, $description, $units, $datatype, $datasize, $hasError, $datalist) = @_;
0519 
0520   my $listsize = $hasError ? $datasize * 2 : $datasize;
0521   if ($datalist) {
0522     if ($listsize != scalar @{$datalist}) {
0523       die "datalist size does not match number of data elements.";
0524     }
0525   } else {
0526     if ($listsize == 1) {
0527       $datalist = [$name];
0528     } elsif ($listsize == 2 && $hasError) {
0529       $datalist = [$name, $name.'_err'];
0530     } elsif ($listsize > 2 && $hasError) {
0531       $datalist = [];
0532       for (0..($listsize/2 - 1) ) {
0533     my $num = sprintf '%03d', $_;
0534     push @{$datalist}, $name.$num, $name.'_err'.$num;
0535       }
0536     } else {
0537       for (0..($listsize - 1) ) {
0538     my $num = sprintf '%03d', $_;
0539     push @{$datalist}, $name.$num;
0540       }
0541     }
0542   }
0543   
0544   my $sql;
0545   { no warnings;
0546     my $fieldlist = join ',', qw(name description units
0547                  datatype datasize hasError);
0548     my $valuelist = join ',', map "\'$_\'", ($name, $description, $units,
0549                          $datatype, $datasize, $hasError);
0550     $sql = qq[ INSERT INTO conditionDescription ($fieldlist)
0551                  VALUES ($valuelist) ];
0552     $sql =~ s/\'\'/NULL/g;
0553   }
0554   $dbh->do($sql);
0555 
0556   my $colindex = 0;
0557   $sql = qq[ INSERT into conditionColumns VALUES (?, ?, ?) ];
0558   my $insert = $dbh->prepare($sql);
0559   foreach (@{$datalist}) {
0560     $insert->execute($name, $colindex, $_);
0561     $colindex++;
0562   }
0563 
0564   return 1;
0565 }
0566 
0567 # insert a channel
0568 sub insert_channel {
0569     my $this = shift;
0570     my $dbh = $this->ensure_connect();
0571 
0572     my %args = @_;
0573 
0574     my $name = $args{-name};
0575     my ($id1, $id2, $id3) = @{ $args{-channel_ids} };
0576     my $maps_to = $args{-maps_to};
0577     my $logic_id = $args{-logic_id};
0578 
0579     # it is a direct view  by default
0580     $maps_to = $name unless $maps_to;
0581 
0582     # XXX check exists, types are ok, etc
0583 
0584     my $sql;
0585     my $fieldlist = join ',', qw(name id1 id2 id3 maps_to logic_id);
0586     my $valuelist = join ',', ('?')x6;
0587     $sql = qq[ INSERT INTO channelView ($fieldlist)
0588          VALUES ($valuelist) ];
0589 
0590     my $sth = $dbh->prepare_cached($sql);
0591     $sth->execute($name, $id1, $id2, $id3, $maps_to, $logic_id);
0592 
0593     return 1;
0594 }
0595 
0596 # validates and inserts a condition to the database
0597 sub insert_condition {
0598   my $this = shift;
0599   my $dbh = $this->ensure_connect();
0600 
0601   my %args = @_;
0602 
0603   foreach (qw/-name -logic_id -IoV/) {
0604     unless (defined $args{$_}) {
0605       die "ERROR:  $_ required, $!";
0606     }
0607   }
0608 
0609   my $name = $args{-name};
0610   my $logic_id = $args{-logic_id};
0611   my $IoV = $args{-IoV};
0612   my $value = $args{-value}; # single value
0613   my $error = $args{-error}; # single error
0614   my $values = $args{-values}; # arrayref of values
0615   my $errors = $args{-errors}; # arrayref of errors
0616   my $hasError = (defined $error || defined $errors);
0617 
0618   $name = "COND_".$name unless $name =~ /^COND_/;
0619 
0620   if ((defined $value && defined $values) ||
0621       (defined $error && defined $errors)) {
0622     die "ERROR:  defined input of both scalar and array\n";
0623   }
0624 
0625   # check that the IoV is valid
0626   unless (check_iov($IoV)) {
0627     die "ERROR:  IoV ($IoV->{since}, $IoV->{till}) fails validation\n";
0628   }
0629 
0630   # check that the IoV does not overlap something in the DB
0631   if ($this->{check_overlap}) {
0632     my $overlap = $this->is_overlap(-name=>$name,
0633                     -logic_id=>$logic_id,
0634                     -IoV=>$IoV);
0635     if ($overlap) {
0636       die "ERROR:  overlapping condition:\n", $overlap;
0637     }
0638   }
0639 
0640   # check to see if a statement has been prepared
0641   unless (exists $this->{prepared}->{$name}) {
0642     $this->prepare_cached(-name=>$name);
0643   }
0644 
0645   if ($this->{counter} == 0) { $this->begin_work(); }
0646 
0647   my @vars = ($logic_id, $IoV->{since}, $IoV->{till});
0648   if (defined $value) {
0649     push @vars, $value;
0650     push @vars, $error if $hasError;
0651   } elsif (defined $values && !defined $errors) {
0652     push @vars, @{$values};
0653   } elsif (defined $values && defined $errors) {
0654     my $num_vals = scalar @{$values};
0655     my $num_errs = scalar @{$errors};
0656     unless ($num_vals == $num_errs) {
0657       die "ERROR:  Number of values different than number of errors, $!";
0658     }
0659     for (0..$num_vals-1) {
0660       push @vars, shift @{$values}, shift @{$errors};
0661     }
0662   } else {
0663     die "ERROR:  undefined data input\n";
0664   }
0665 
0666   # XXX should check that the number of params matches the expected datasize
0667 
0668   my $sth = $this->{prepared}->{$name};
0669   $sth->execute(@vars);
0670 
0671   # counter management.  For performance evaluation
0672   $this->{counter}++;
0673   if ($this->{counter} >= $this->{max_cnt}) {
0674     $this->commit();
0675     $this->{counter} = 0;
0676   }
0677   return 1;
0678 }
0679 
0680 # insert a bunch of data into a CLOB
0681 sub insert_condition_clob {
0682   my $this = shift;
0683 
0684   my $dbh = $this->ensure_connect();
0685 
0686   my %args = @_;
0687 
0688   foreach (qw/-name -data -logic_ids -IoV/) {
0689     unless (defined $args{$_}) {
0690       die "ERROR:  $_ required, $!";
0691     }
0692   }
0693 
0694   my $name = $args{-name};
0695   my $logic_ids = $args{-logic_ids};
0696   my $data = $args{-data};
0697   my $IoV = $args{-IoV};
0698 
0699   $name = "CNDC_".$name unless $name =~ /^CNDC_/;
0700   
0701   unless (scalar @{$logic_ids} == scalar @{$data}) {
0702     die "Missmatched arrays of logic_ids and data\n";
0703   }
0704   
0705   my $clob = "";
0706   for my $i (0..$#{$logic_ids}) {
0707     my $datalist = join ',', @{$data->[$i]};
0708     $clob .= $logic_ids->[$i] . '=' . $datalist . ';';
0709   }
0710   chop $clob;
0711 
0712   my $insert = $dbh->prepare(qq[INSERT INTO ${name} VALUES (?, ?, ?)]);
0713 
0714   { no warnings;
0715     $insert->bind_param(1, $IoV->{since});
0716     $insert->bind_param(2, $IoV->{till});
0717     $insert->bind_param(3, $clob);
0718     $insert->execute();
0719   }
0720 
0721   return 1;
0722 }
0723 
0724 # insert a run
0725 sub insert_run {
0726   my $this = shift;
0727   my $dbh = $this->{dbh};
0728 
0729   my %args = @_;
0730   my $run_number = $args{-run_number};
0731   my $IoV = $args{-IoV};
0732 
0733   unless (defined $run_number) {
0734     die "ERROR:  insert_run needs -run_number\n";
0735   }
0736 
0737   # check that the IoV is valid
0738   unless (check_iov($IoV)) {
0739     die "ERROR:  IoV ($IoV->{since}, $IoV->{till}) fails validation\n";
0740   }
0741 
0742   my $sql = qq[ INSERT INTO runs VALUES (?, ?, ?, NULL, NULL) ];
0743   my $insert = $dbh->prepare_cached($sql);
0744   
0745   $insert->execute($run_number, $IoV->{since}, $IoV->{till});
0746 
0747   return 1;
0748 }
0749 
0750 # update a run
0751 sub update_run {
0752   my $this = shift;
0753 
0754   my %args = @_;
0755 
0756   my $run = $args{-run_number};
0757   my $status = $args{-status};
0758   my $comments = $args{-comments};
0759 
0760   unless (defined $run && defined $status) {
0761     die "Need to at least send a status to update_run.  skipping.\n";
0762   }
0763   
0764   unless (defined $comments) {
0765     $comments = "NULL";
0766   }
0767 
0768   my $sql = qq[ UPDATE runs SET status=$status, comments='$comments'
0769         WHERE run_number=$run ];
0770 
0771   $this->{dbh}->do($sql);
0772   return 1;
0773 }
0774 
0775 sub prepare_cached {
0776   my $this = shift;
0777   my $dbh = $this->ensure_connect();
0778 
0779   my %args = @_;
0780 
0781   unless (defined $args{'-name'}) {
0782     die "ERROR:  $_ required, $!";
0783   }
0784 
0785   my $name = $args{-name};
0786 
0787   $name = "COND_".$name unless $name =~ /^COND_/;
0788   my $desc = $this->get_conditionDescription(-name=>$name);
0789   unless (defined $desc) {
0790     die "ERROR:  Condition $name is not defined in the DB\n";
0791   }
0792   my $hasError = $desc->{HASERROR};
0793   my $datasize = $desc->{DATASIZE};
0794 
0795   my $sql;
0796   { no warnings;
0797     my @fields = qw(logic_id since till);
0798 
0799     for (0..$datasize-1) {
0800       push @fields, sprintf("value%02d", $_);
0801       if ($hasError) {
0802     push @fields, sprintf("error%02d", $_);
0803       }
0804     }
0805     my $fieldlist = join ',', @fields;
0806     my $valuelist = join ',', ('?') x scalar @fields;
0807 
0808     $sql = qq[ INSERT INTO $name ($fieldlist) VALUES ($valuelist) ];
0809   }
0810   my $sth = $dbh->prepare_cached($sql);
0811   $this->{prepared}->{$name} = $sth;
0812 
0813   return 1;
0814 }
0815 
0816 # returns overlap information if the given $IoV has any overlaps with IoVs 
0817 # in the DB.  Else returns 0
0818 sub is_overlap {
0819   my $this = shift;
0820   my $dbh = $this->ensure_connect();
0821 
0822   my %args = @_;
0823   my $name = $args{-name};
0824   my $logic_id = $args{-logic_id};
0825   my $IoV = $args{-IoV};
0826 
0827   my $t1 = $IoV->{since};
0828   my $t2 = $IoV->{till};
0829 
0830   my $sql;
0831 
0832   unless (exists $this->{prepared_overlap}->{$name}) {
0833     $this->prepare_overlap_check(-name=>$name);
0834   }
0835 
0836   my $sth = $this->{prepared_overlap}->{$name};
0837   $sth->execute($logic_id, $t1, $t2, $t1, $t2, $t1, $t2);
0838 #  $sth->execute(($logic_id, $t1, $t2)x3);
0839   my ($db_id, $db_t1, $db_t2) = $sth->fetchrow_array();
0840 
0841   if ($db_id) {
0842     my $in_str = "input:  ". join ' ', $logic_id, $t1, $t2;
0843     my $db_str = "   db:  ". join ' ', $db_id, $db_t1, $db_t2;
0844     return "$in_str\n$db_str";
0845   } else {
0846     return 0;
0847   }
0848 }
0849 
0850 sub prepare_overlap_check {
0851   my $this = shift;
0852   my $dbh = $this->ensure_connect();
0853 
0854   my %args = @_;
0855 
0856   unless (defined $args{'-name'}) {
0857     die "ERROR:  $_ required, $!";
0858   }
0859 
0860   my $name = $args{-name};
0861 
0862   $name = "COND_".$name unless $name =~ /^COND_/;
0863 
0864   my $sql;
0865   { no warnings;
0866     # argument order is logic_id, t1, t2, t1, t2, t1, t2
0867     $sql = qq[ SELECT logic_id, since, till FROM $name
0868            WHERE logic_id = ?
0869              AND ((since >= ? AND since < ?)
0870                   OR (till  >  ? AND till  < ?)
0871                   OR (? >= since AND ? < till))
0872          ];
0873   }
0874 
0875 
0876 #    { no warnings;
0877 #      $sql = qq[ SELECT logic_id, since, till FROM $name
0878 #            WHERE logic_id = ?
0879 #            AND (since >= ? AND since < ?)
0880 #          UNION
0881 #          SELECT logic_id, since, till FROM $name
0882 #            WHERE logic_id = ?
0883 #            AND (till  >  ? AND till  < ?)
0884 #          UNION
0885 #          SELECT logic_id, since, till FROM $name
0886 #            WHERE logic_id = ?
0887 #            AND (? >= since AND ? < till) ];
0888 #    }
0889 
0890   my $sth = $dbh->prepare_cached($sql);
0891   $this->{prepared_overlap}->{$name} = $sth;
0892 
0893   return 1;
0894 }
0895 
0896 
0897 # get a condition, returns a scalar only if the condition table is only
0898 # defined as a sigle value.  else it returns an array in the form
0899 # (value00, value01, value03, ...) or
0900 # (value00, error00, value01, error01, ...)
0901 # depending on if there are errors defined
0902 sub get_condition {
0903   my $this = shift;
0904   my $dbh = $this->ensure_connect();
0905 
0906   my %args = @_;
0907   my $name = $args{-name};
0908   my $logic_id = $args{-logic_id};
0909   my $time = $args{-time};
0910 
0911   $name = "COND_".$name unless $name =~ /^COND_/;
0912 
0913   my @fields;
0914   my $desc = $this->get_conditionDescription(-name=>$name);
0915   unless (defined $desc) {
0916     die "ERROR:  Condition $name is not defined in the DB\n";
0917   }
0918   my $hasError = $desc->{HASERROR};
0919   my $datasize = $desc->{DATASIZE};
0920 
0921   for (0..$datasize-1) {
0922     push @fields, sprintf("value%02d", $_);
0923     if ($hasError) {
0924       push @fields, sprintf("error%02d", $_);
0925     }
0926   }
0927   my $fields = join ',', @fields;
0928 
0929   my $sql;
0930   { no warnings;
0931     $sql = qq[ SELECT $fields FROM $name
0932            WHERE logic_id='$logic_id'
0933              AND since <= '$time'
0934              AND till  >  '$time' ];
0935   }
0936 
0937   my @results = @{$dbh->selectall_arrayref($sql)};
0938   if (scalar @results > 1) {
0939     warn "ERROR:  Overlapping IoV found in table $name, logic_id, $logic_id, ".
0940       "time $time";
0941   }
0942 
0943   if (scalar @{$results[0]} == 1) {
0944     return $results[0][0];
0945   } else {
0946     return @{$results[0]};
0947   }
0948 }
0949 
0950 # return an entire channel map of view_ids pointing to a logic_id
0951 sub get_channelView {
0952   my $this = shift;
0953   my $dbh = $this->ensure_connect();
0954 
0955   my %args = @_;
0956   my $name = $args{-name};
0957   my $maps_to = $args{-maps_to};
0958 
0959   # channel is a canonical channel by default
0960   $maps_to = $name unless $maps_to;
0961 
0962   my $sql;
0963   { no warnings;
0964     $sql = qq[ SELECT id1, id2, id3, logic_id
0965            FROM channelView WHERE name='$name' AND maps_to='$maps_to'];
0966   }
0967 
0968   # this recursive subroutine turns an array of values into a hash tree with
0969   # the last item as the leaf
0970   # e.g. ($ref, 1, 2, 3, undef, undef, undef, "VALUE")
0971   # makes $ref->{1}->{2}->{3} = "VALUE"
0972   # sub tack_on {
0973 #     my ($ref, @values) = @_;
0974 #     my $key = shift @values;
0975 #     if (defined $key && defined $values[0]) {
0976 #       $ref->{$key} = {} unless exists $ref->{$key};
0977 #       tack_on($ref->{$key}, @values);
0978 #     } else {
0979 #       $ref->{$key} = pop @values;
0980 #     }
0981 #   }
0982 
0983 #   my $view = {};
0984 #   my @results = @{$dbh->selectall_arrayref($sql)};
0985 #   foreach (@results) {
0986 #     my @row = @{$_};
0987 #     tack_on($view, @row);
0988 #   }
0989 
0990   my $view = {};
0991   my @results = @{$dbh->selectall_arrayref($sql)};
0992   
0993   if (scalar @results == 0) {
0994     return undef;
0995   }
0996 
0997   foreach (@results) {
0998     my ($id1, $id2, $id3, $logic_id) = map {defined $_ ? $_ : ''} @{$_};
0999     $view->{$id1}->{$id2}->{$id3} = $logic_id;
1000   }
1001 
1002   return $view;
1003 }
1004 
1005 # returns an array of logic_ids for used in a channelView
1006 sub get_channelView_logic_ids {
1007   my $this = shift;
1008   my $dbh = $this->ensure_connect();
1009 
1010   my %args = @_;
1011   my $name = $args{-name};
1012   my $maps_to = $args{-maps_to};
1013 
1014   # channel is a canonical channel by default
1015   $maps_to = $name unless $maps_to;
1016 
1017   my $sql;
1018   $sql = qq[ SELECT logic_id
1019          FROM channelView WHERE name='$name' AND maps_to='$maps_to'
1020              ORDER BY id1, id2, id3
1021            ];
1022   return @{$dbh->selectcol_arrayref($sql)};
1023 }
1024 
1025 # returns true if a condition type has an error defined
1026 sub hasError {
1027   my $this = shift;
1028   my $dbh = $this->ensure_connect();
1029 
1030   my %args = @_;
1031   my $name = $args{-name};
1032 
1033   my $desc = $this->get_conditionDescription(-name=>$name);
1034   return $desc->{HASERROR};
1035 }
1036 
1037 # return a list of condition types defined in the DB
1038 sub get_conditionDescription {
1039   my $this = shift;
1040   my $dbh = $this->ensure_connect();
1041 
1042   my %args = @_;
1043   my $name = $args{-name};
1044 
1045   my $sql;
1046   { no warnings;
1047     $sql = qq[ SELECT * FROM conditionDescription WHERE name='$name'];
1048   }
1049 
1050   return $dbh->selectrow_hashref($sql);
1051 }
1052 
1053 # return a list of channel view types defined in the DB
1054 sub get_view_description {
1055 }
1056 
1057 # die if we are not connected
1058 sub ensure_connect {
1059   my $this = shift;
1060 
1061   unless (exists $this->{dbh} && defined $this->{dbh}) {
1062     die "ERROR:  Not connected to database.\n";
1063   }
1064 
1065   # XXX really check the connection
1066 
1067   return $this->{dbh};
1068 }
1069 
1070 sub table_exists {
1071   my $this = shift;
1072   my $dbh = $this->{dbh};
1073   my $table = shift;
1074   $table = uc $table;
1075   my $sql = qq[ SELECT 1 FROM user_tables WHERE table_name='$table'];
1076   return $dbh->selectrow_array($sql);
1077 }
1078 
1079 
1080 ###
1081 ###   PRIVATE FUNCTIONS
1082 ###
1083 
1084 sub check_names {
1085   no warnings;
1086   foreach (@_) {
1087     my $count = length $_;
1088     if ($count > $MAXNAME) {
1089       die "ERROR:  Name \"$_\" is too long.  Names for conditions and ids ".
1090     "can only be $MAXNAME characters long\n";
1091     }
1092   }
1093 }
1094 
1095 sub check_date {
1096   my $date = shift;
1097 
1098   return 0 unless defined $date;
1099 
1100   my @date = ($date =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/);
1101 
1102   foreach (@date) {
1103     return 0 unless defined $_;
1104   }
1105 
1106   if ($date[0] < 0 || $date[0] > 9999 || # year
1107       $date[1] < 1 || $date[1] > 12 ||   # month
1108       $date[2] < 1 || $date[2] > 31 ||   # day
1109       $date[3] < 0 || $date[3] > 23 ||   # hour
1110       $date[4] < 0 || $date[4] > 59 ||   # minute
1111       $date[5] < 0 || $date[5] > 59) {   # second
1112     return 0;
1113   }
1114 
1115   return 1;
1116 }
1117 
1118 sub check_iov {
1119   my $IoV = shift;
1120   return (check_date($IoV->{since}) &&               # since valid
1121       check_date($IoV->{till})  &&               # till valid
1122       ($IoV->{since} lt $IoV->{till})            # since < till
1123      );
1124 }
1125 
1126 1;