File Coverage

blib/lib/oEdtk/DBAdmin.pm
Criterion Covered Total %
statement 21 301 6.9
branch 0 62 0.0
condition 0 13 0.0
subroutine 7 27 25.9
pod 0 17 0.0
total 28 420 6.6


line stmt bran cond sub pod time code
1             package oEdtk::DBAdmin;
2              
3 1     1   2046 use DBI;
  1         20469  
  1         116  
4 1     1   16 use oEdtk::Config qw(config_read);
  1         2  
  1         60  
5 1     1   8 use POSIX qw(strftime);
  1         4  
  1         10  
6 1     1   72 use Text::CSV;
  1         2  
  1         14  
7 1     1   24 use strict;
  1         3  
  1         38  
8 1     1   6 use warnings;
  1         2  
  1         41  
9              
10 1     1   6 use Exporter;
  1         2  
  1         4218  
11              
12             our $VERSION = 0.8025;
13             our @ISA = qw(Exporter);
14             our @EXPORT_OK = qw(
15             csv_import
16             create_lot_sequence
17             create_SCHEMA
18             create_table_ACQUIT
19             create_table_DATAGROUPS
20             create_table_FILIERES
21             create_table_INDEX
22             create_table_LOTS
23             create_table_PARA
24             create_table_REFIDDOC
25             create_table_SUPPORTS
26             create_table_TRACKING
27             db_connect
28             db_backup_agent
29             historicize_table
30             copy_table
31             move_table
32             @INDEX_COLS
33             );
34              
35              
36             sub move_table (@){
37 0     0 0   warn "INFO : method oEdtk::DBAdmin::move_table is deprecated you should use oEdtk::DBAdmin::copy_table\n";
38 0           copy_table (@_);
39 0           1;
40             }
41              
42              
43             sub copy_table ($$$;$){
44 0     0 0   my ($dbh, $table_source, $table_cible, $create_option) = @_;
45 0   0       $create_option ||= "";
46              
47             # check if source is empty
48 0           my $sql_check_source = "SELECT SIGN(COUNT(*)) FROM ".$table_source;
49 0           my $sth = $dbh->prepare($sql_check_source);
50 0           $sth->execute();
51 0           my $result = $sth->fetchrow_array;
52 0 0         unless ($result){
53 0           warn "INFO : source $table_source is empty, copy aborted\n";
54 0           return 1;
55             }
56              
57             # preparing data copy from source to cible
58 0           warn "INFO : data from $table_source will be copyed into $table_cible\n";
59 0 0         if ($create_option =~/-create/i) {
60 0           my $sql_create = "CREATE TABLE ".$table_cible." AS SELECT * FROM ".$table_source;
61             # en cas d'erreur, DIE pour protéger toute autre opération sur les bases (db_backup_agent, ...)
62 0 0         $dbh->do($sql_create, undef, ) or die $dbh->errstr;
63              
64             } else {
65 0           my $sql_insert = "INSERT INTO ".$table_cible." SELECT * FROM ".$table_source;
66             # en cas d'erreur, DIE pour protéger toute autre opération sur les bases (db_backup_agent, ...)
67 0 0         $dbh->do($sql_insert, undef, ) or die $dbh->errstr;
68             }
69            
70 0           warn "INFO : insert done into $table_cible\n";
71 0           1;
72             }
73              
74              
75             sub csv_import ($$$;$){
76             # insertion d'un fichier csv dans une table
77             # csv_import($dbh, "EDTK_ACQ", $ARGV[0],
78             # {sep_char => ',' , # ',' is default value
79             # quote_char => '"', # '"' is default value
80             # header => 'ED_SEQLOT,ED_LOTNAME,...'}, # default value, no header, read header from csv file
81             # mode => 'merge'); # 'insert' is default value
82              
83             ###### VERSION ORACLE DU MERGE, DIFFÉRENTE DE CELLE DE POSTGRESQL
84             #MERGE INTO table_name USING table_reference ON (condition)
85             # WHEN MATCHED THEN
86             # UPDATE SET column1 = value1 [, column2 = value2 ...]
87             # WHEN NOT MATCHED THEN
88             # INSERT (column1 [, column2 ...]) VALUES (value1 [, value2 ...
89              
90             #MERGE INTO Table1 T1
91             # USING (SELECT Id, Meschamps FROM Table2) T2
92             # ON ( T1.Id = T2.Id ) -- Condition de correspondance
93             #WHEN MATCHED THEN -- Si Vraie
94             # UPDATE SET T1.Meschamps = T2.Meschamps
95             #WHEN NOT MATCHED THEN -- Si faux
96             # INSERT (T1.ID, T1.MesChamps) VALUES ( T2.ID, T2.MesChamps);
97              
98             ###### VERSION POSTGRESQL
99             #MERGE INTO table [[AS] alias]
100             #USING [table-ref | query]
101             #ON join-condition
102             #[WHEN MATCHED [AND condition] THEN MergeUpdate | DELETE | DO NOTHING | RAISE ERROR]
103             #[WHEN NOT MATCHED [AND condition] THEN MergeInsert | DO NOTHING | RAISE ERROR]
104             #MergeUpdate is
105             #
106             #UPDATE SET { column = { expression | DEFAULT } |
107             #( column [, ...] ) = ( { expression | DEFAULT } [, ...] ) }
108             #[, ...]
109             #(yes, there is no WHERE clause here)
110             #MergeInsert is
111             #INSERT [ ( column [, ...] ) ]
112             #{ DEFAULT VALUES | VALUES ( { expression | DEFAULT } [, ...] )
113             #[, ...]}
114              
115 0     0 0   my ($dbh, $table, $in, $params) = @_;
116 0   0       $params->{'mode'} = $params->{'mode'} || "insert";
117 0   0       $params->{'sep_char'} = $params->{'sep_char'} || ",";
118 0   0       $params->{'quote_char'} = $params->{'quote_char'}||'"' ;
119            
120 0 0         open(my $fh, '<', $in) or die "ERROR: Cannot open index file \"$in\": $!\n";
121 0           my $csv = Text::CSV->new({ binary => 1, sep_char => $params->{'sep_char'},
122             quote_char => $params->{'quote_char'}});
123              
124 0           my $line;
125 0 0         if (defined $params->{'header'}){
126 0           $line =$params->{'header'};
127             } else {
128 0           $line = <$fh>;
129             }
130 0           $csv->parse($line);
131 0           my @cols = $csv->fields();
132              
133 0           while (<$fh>) {
134 0           $csv->parse($_);
135 0           my @data = $csv->fields();
136              
137             # s'assurer qu'on insère pas des valeurs null (contraintes ???) ou pas ?
138 0           for (my $i=0 ; $i<=$#data ; $i++ ){
139 0   0       $data[$i]=$data[$i] || "";
140             }
141 0           my ($sql, $seqlot);
142            
143 0 0         if ($params->{'mode'}=~/merge/i) {
144 0           $sql = "SELECT " . $cols[0] . " FROM " . $table
145             . " WHERE " . $cols[0] . " =? ";
146 0           my $sth = $dbh->prepare_cached($sql);
147 0           $sth->execute($data[0]);
148              
149 0           $seqlot = $sth->fetchrow_hashref();
150             }
151            
152 0 0         if (defined $seqlot->{'ED_SEQLOT'}) {
153 0           $sql = "UPDATE " . $table . " SET " . join ('=? , ', @cols) . "=? "
154             . " WHERE " . $cols[0] . " =? ";
155 0           my $sth = $dbh->prepare_cached($sql);
156 0           $sth->execute(@data, $data[0]);
157            
158             } else {
159 0           $sql = "INSERT INTO " . $table . " (" . join(',', @cols)
160             . ") VALUES (" . join(',', ('?') x @cols) . ")";
161 0           my $sth = $dbh->prepare_cached($sql);
162 0           $sth->execute(@data);
163             }
164              
165             }
166 0           close($fh);
167             }
168              
169              
170             sub _db_connect1 {
171 0     0     my ($cfg, $dsnvar, $dbargs) = @_;
172 0           my $dbh;
173 0           my $dsn = $cfg->{$dsnvar};
174              
175 0           warn "INFO : Connecting to DSN $dsn, $dsnvar...\n";
176              
177             # gestion de la connexion dans une boucle temporisée, pour effectuer 3 tentatives de connexion avec incrément de pause
178 0           for (my $i=0;$i<3;$i++){
179 0           sleep ($cfg->{EDTK_WAITRUN}*$i);
180 0           eval {
181 0           $dbh=DBI->connect($dsn, $cfg->{"${dsnvar}_USER"}, $cfg->{"${dsnvar}_PASS"}, $dbargs); ## xxxx
182             };
183              
184 0 0         if ($@){
185             # en cas d'incident de connexion, on ne dit rien, on essaie encore
186 0           warn "INFO : DBI connection missmatch to $dsnvar, we try 3 times\n";
187 0           warn "INFO : error message was : $@\n";
188              
189             } else {
190             # si ça semble bon on sort
191 0           $i=4;
192             }
193             }
194 0           return $dbh;
195             }
196              
197              
198             sub db_connect {
199 0     0 0   my ($cfg, $dsnvar, $dbargs) = @_;
200              
201             # This avoids problems with PostgreSQL where in some cases, the column
202             # names are lowercase instead of uppercase as we assume everywhere.
203 0           $dbargs->{'FetchHashKeyName'} = 'NAME_uc';
204              
205             # Connect to the database.
206 0           my $dbh = _db_connect1($cfg, $dsnvar, $dbargs);
207              
208             # If we could not connect to the database server, try
209             # to connect to the backup database server if there is one.
210 0 0         if (!defined $dbh) {
211 0 0         if (defined $cfg->{"${dsnvar}_BAK"}) { # il faudrait ajouter le paramétrage dans la base de backup (procédure de création de cette base)
212 0           warn "ERROR: Could not connect to main database server: $DBI::errstr\n";
213 0           $dbh = _db_connect1($cfg, "${dsnvar}_BAK", $dbargs);
214 0 0         if (!defined $dbh) {
215 0           die "ERROR: Could not connect to backup database server : $DBI::errstr\n";
216             }
217             } else {
218 0           die "ERROR: Could not connect to database server : $DBI::errstr\n";
219             }
220             }
221 0           return $dbh;
222             }
223              
224              
225             sub create_table_TRACKING {
226 0     0 0   my ($dbh, $table, $maxkeys) = @_;
227              
228 0           my $sql = "CREATE TABLE $table";
229 0           $sql .= "( ED_TSTAMP VARCHAR2(14) NOT NULL"; # Timestamp of event
230 0           $sql .= ", ED_USER VARCHAR2(10) NOT NULL"; # Job request user
231 0           $sql .= ", ED_SEQ INTEGER NOT NULL"; # Sequence
232 0           $sql .= ", ED_SNGL_ID VARCHAR2(17) NOT NULL";#xx ED_IDLDOC Single ID : format YWWWDHHMMSSPPPP.U (compuset se limite ? 16 digits : 15 entiers, 1 decimal)
233 0           $sql .= ", ED_APP VARCHAR2(20) NOT NULL"; #xx ED_REFIDDOC Application name
234 0           $sql .= ", ED_MOD_ED CHAR"; # Editing mode (Batch, Tp, Web, Mail)
235 0           $sql .= ", ED_JOB_EVT CHAR"; # Level of the event (Spool, Document, Line, Warning, Error)
236 0           $sql .= ", ED_CORP VARCHAR2(8) NOT NULL"; # Entity related to the document
237 0           $sql .= ", ED_SOURCE VARCHAR2(128)"; # Input stream of this document
238 0           $sql .= ", ED_OBJ_COUNT INTEGER"; # Number of objects attached to the event
239 0           $sql .= ", ED_MESSAGE VARCHAR2(256)"; # Input stream of this document # alter table EDTK_TRACKING add ED_MESSAGE VARCHAR2(256)
240             # alter table EDTK_TRACK_2012 add ED_MESSAGE VARCHAR2(256);
241 0           $sql .= ", ED_HOST VARCHAR2(32)"; # Input stream of this document
242              
243 0           foreach my $i (0 .. $maxkeys) {
244 0           $sql .= ", ED_K${i}_NAME VARCHAR2(8)"; # Name of key $i
245 0           $sql .= ", ED_K${i}_VAL VARCHAR2(128)"; # Value of key $i
246             }
247             # $sql .= ", PRIMARY KEY (ED_SNGL_ID, ED_JOB_EVT, ED_APP)"
248 0           $sql .= " )"; #, CONSTRAINT pk_$ENV{EDTK_DBI_TABLENAME} PRIMARY KEY (ED_TSTAMP, ED_PROC, ED_SEQ)";
249              
250 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
251             }
252              
253              
254             sub _drop_table_TRACKING {
255 0     0     my ($dbh, $table) = @_;
256              
257 0 0         $dbh->do("DROP TABLE $table") or die $dbh->errstr;
258             }
259              
260              
261             sub historicize_table ($$$){
262 0     0 0   my ($dbh, $table, $suffixe) = @_;
263 0           my $table_cible =$table."_".$suffixe;
264            
265 0           copy_table ($dbh, $table, $table_cible, '-create');
266              
267 0           my $sql = "TRUNCATE TABLE $table"; # LA CA DEVIENT UN 'MOVE'
268 0 0         $dbh->do($sql, undef) or die $dbh->errstr;
269             }
270              
271              
272             sub db_backup_agent($){
273             # purge sauvegardée des 3 tables de productions : EDTK_DBI_TRACKING EDTK_DBI_OUTMNGR EDTK_DBI_ACQUIT
274             # en fonction du paramétrage EDTK_ENTIRE_YEARS_KEPT
275 0     0 0   my ($dbh) = shift;
276 0           my $cfg = config_read('EDTK_DB');
277 0 0 0       unless (defined ($cfg->{'EDTK_ENTIRE_YEARS_KEPT'}) && $cfg->{'EDTK_ENTIRE_YEARS_KEPT'} > 0){
278 0           warn "INFO : EDTK_ENTIRE_YEARS_KEPT not defined for optimization purge. db_backup_agent not needed.\n";
279 0           return 1;
280             }
281              
282 0           my $suffixe = strftime ("%Y%m%d", localtime);
283 0           $suffixe .="_BAK";
284 0           my $cur_year = strftime ("%Y", localtime);
285              
286             { # isole le block pour les variables locales
287             # CHECK IF EDTK_DBI_TRACKING HAS OLD STATS
288 0           my $sql_check="SELECT COUNT(ED_TSTAMP) FROM ".$cfg->{'EDTK_DBI_TRACKING'}." WHERE ED_TSTAMP < ? ";
  0            
289 0           my $check = ($cur_year - $cfg->{'EDTK_ENTIRE_YEARS_KEPT'}) . "0101000000";
290 0           my $sth = $dbh->prepare($sql_check);
291              
292 0           $sth->execute($check);
293 0           my $result = $sth->fetchrow_array;
294 0 0         unless ($result){
295 0           warn "INFO : db_backup_agent has nothing to do with ".$cfg->{'EDTK_DBI_TRACKING'}."\n";
296             } else {
297 0           my $cible = $cfg->{'EDTK_DBI_TRACKING'}."_".$suffixe;
298 0           copy_table ($dbh, $cfg->{'EDTK_DBI_TRACKING'}, $cible, '-create');
299 0           warn "INFO : db_backup_agent done with ".$cfg->{'EDTK_DBI_TRACKING'}." for data older than $check.\n";
300              
301 0           my $sql_clean = "DELETE FROM ".$cfg->{'EDTK_DBI_TRACKING'}." WHERE ED_TSTAMP < ? ";
302 0 0         $dbh->do($sql_clean, undef, $check) or die $dbh->errstr;
303             }
304             }
305              
306             { # isole le block pour les variables locales
307             # CHECK IF EDTK_DBI_OUTMNGR HAS OLD STATS
308 0           my $sql_check="SELECT COUNT(ED_DTEDTION) FROM ".$cfg->{'EDTK_DBI_OUTMNGR'}." WHERE ED_DTEDTION < ? ";
  0            
309 0           my $check = ($cur_year - $cfg->{'EDTK_ENTIRE_YEARS_KEPT'}) . "0101";
310 0           my $sth = $dbh->prepare($sql_check);
311              
312 0           $sth->execute($check);
313 0           my $result = $sth->fetchrow_array;
314 0 0         unless ($result){
315 0           warn "INFO : db_backup_agent has nothing to do with ".$cfg->{'EDTK_DBI_OUTMNGR'}."\n";
316             } else {
317 0           my $cible = $cfg->{'EDTK_DBI_OUTMNGR'}."_".$suffixe;
318 0           copy_table ($dbh, $cfg->{'EDTK_DBI_OUTMNGR'}, $cible, '-create');
319              
320 0           my $sql_clean = "DELETE FROM ".$cfg->{'EDTK_DBI_OUTMNGR'}." WHERE ED_DTEDTION < ? ";
321 0 0         $dbh->do($sql_clean, undef, $check) or die $dbh->errstr;
322              
323 0           warn "INFO : db_backup_agent done with ".$cfg->{'EDTK_DBI_OUTMNGR'}." for data older than $check.\n";
324             }
325             }
326              
327             { # isole le block pour les variables locales
328             # CHECK IF EDTK_DBI_ACQUIT HAS OLD STATS
329 0           my $sql_check="SELECT COUNT (ED_DTPOST) FROM ".$cfg->{'EDTK_DBI_ACQUIT'}." WHERE ED_DTPOST < ? ";
  0            
330 0           my $check = ($cur_year - $cfg->{'EDTK_ENTIRE_YEARS_KEPT'}) . "0101";
331 0           my $sth = $dbh->prepare($sql_check);
332              
333 0           $sth->execute($check);
334 0           my $result = $sth->fetchrow_array;
335 0 0         unless ($result){
336 0           warn "INFO : db_backup_agent has nothing to do with ".$cfg->{'EDTK_DBI_ACQUIT'}."\n";
337             } else {
338 0           my $cible = $cfg->{'EDTK_DBI_ACQUIT'}."_".$suffixe;
339 0           copy_table ($dbh, $cfg->{'EDTK_DBI_ACQUIT'}, $cible, '-create');
340            
341 0           my $sql_clean = "DELETE FROM ".$cfg->{'EDTK_DBI_ACQUIT'}." WHERE ED_DTPOST < ? ";
342 0 0         $dbh->do($sql_clean, undef, $check) or die $dbh->errstr;
343              
344 0           warn "INFO : db_backup_agent done with ".$cfg->{'EDTK_DBI_ACQUIT'}." for data older than $check.\n";
345             }
346             }
347              
348 0           1;
349             }
350              
351              
352             sub create_table_FILIERES {
353 0     0 0   my $dbh = shift;
354 0           my $table = "EDTK_FILIERES";
355              
356 0           my $sql = "CREATE TABLE $table";
357 0           $sql .= "( ED_IDFILIERE VARCHAR2(5) NOT NULL"; # rendre UNIQUE filiere id ALTER table edtk_filieres modify ED_IDFILIERE VARCHAR2(5) NOT NULL;
358 0           $sql .= ", ED_IDMANUFACT VARCHAR2(16)";
359 0           $sql .= ", ED_DESIGNATION VARCHAR2(64)"; #
360 0           $sql .= ", ED_ACTIF CHAR NOT NULL"; # Flag indiquant si la filiere est active ou pas
361 0           $sql .= ", ED_PRIORITE INTEGER UNIQUE"; # rendre UNIQUE Ordre d'execution des filieres ALTER table edtk_filieres modify ED_PRIORITE INTEGER UNIQUE;
362 0           $sql .= ", ED_TYPED CHAR NOT NULL"; #
363 0           $sql .= ", ED_MODEDI CHAR NOT NULL"; #
364 0           $sql .= ", ED_IDGPLOT VARCHAR2(16) NOT NULL"; # alter table EDTK_FILIERES add ED_IDGPLOT VARCHAR2(16)
365 0           $sql .= ", ED_NBBACPRN INTEGER NOT NULL"; #
366 0           $sql .= ", ED_NBENCMAX INTEGER";
367 0           $sql .= ", ED_MINFEUIL_L INTEGER";
368 0           $sql .= ", ED_MAXFEUIL_L INTEGER";
369 0           $sql .= ", ED_FEUILPLI INTEGER";
370 0           $sql .= ", ED_MINPLIS INTEGER";
371 0           $sql .= ", ED_MAXPLIS INTEGER NOT NULL";
372 0           $sql .= ", ED_POIDS_PLI INTEGER"; # poids maximum du pli dans la filiere
373 0           $sql .= ", ED_REF_ENV VARCHAR2(8) NOT NULL";
374 0           $sql .= ", ED_FORMFLUX VARCHAR2(3) NOT NULL";
375 0           $sql .= ", ED_SORT VARCHAR2(128) NOT NULL";
376 0           $sql .= ", ED_DIRECTION VARCHAR2(4) NOT NULL";
377 0           $sql .= ", ED_POSTCOMP VARCHAR2(8) NOT NULL";
378             # $sql .= ", PRIMARY KEY (ED_IDFILIERE, ED_IDMANUFACT, ED_PRIORITE)"
379 0           $sql .= " )";
380              
381 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
382             }
383              
384              
385             sub create_table_LOTS {
386 0     0 0   my $dbh = shift;
387 0           my $table = "EDTK_LOTS";
388              
389 0           my $sql = "CREATE TABLE $table";
390 0           $sql .= "( ED_IDLOT VARCHAR2(8) NOT NULL"; # rendre UNIQUE ? -> ALTER table EDTK_LOTS modify ED_IDLOT VARCHAR2(8) NOT NULL
391 0           $sql .= ", ED_PRIORITE INTEGER UNIQUE"; # rendre UNIQUE -> ALTER table EDTK_LOTS modify ED_PRIORITE INTEGER UNIQUE;
392 0           $sql .= ", ED_IDAPPDOC VARCHAR2(20)"; #xx ED_REFIDDOC ATTENTION cf structure index.xls -> ALTER table EDTK_LOTS modify ED_IDAPPDOC VARCHAR2(20) NULL
393 0           $sql .= ", ED_REFIDDOC VARCHAR2(20) NOT NULL"; # -> alter table EDTK_LOTS add ED_REFIDDOC VARCHAR2(20) -> ALTER table EDTK_LOTS modify ED_REFIDDOC VARCHAR2(20) NOT NULL
394 0           $sql .= ", ED_CPDEST VARCHAR2(8)"; # xxx passer cpdet sur 10 partout -> alter table EDTK_LOTS modify ED_CPDEST VARCHAR2(8);
395 0           $sql .= ", ED_FILTER VARCHAR2(64)"; # -> alter table EDTK_LOTS add ED_FILTER VARCHAR2(64);
396 0           $sql .= ", ED_REFENC VARCHAR2(32)"; # a mettre en place pour ajouter des encarts spécifiques à certains lots (cf impact calcul lotissement) # -> ALTER table EDTK_LOTS modify ED_REFENC VARCHAR2(32);
397 0           $sql .= ", ED_GROUPBY VARCHAR2(16)";
398 0           $sql .= ", ED_LOTNAME VARCHAR2(16) NOT NULL"; # -> ALTER table EDTK_LOTS modify ED_LOTNAME VARCHAR2(64) NOT NULL;
399 0           $sql .= ", ED_IDGPLOT VARCHAR2(16) NOT NULL";
400 0           $sql .= ", ED_IDMANUFACT VARCHAR2(16) NOT NULL";
401 0           $sql .= ", ED_CONSIGNE VARCHAR2(250) "; # alter table EDTK_LOTS add ED_CONSIGNE VARCHAR2(250)
402             # $sql .= ", PRIMARY KEY (ED_IDLOT, ED_PRIORITE, ED_REFIDDOC)"
403 0           $sql .= " )";
404              
405 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
406             }
407              
408              
409             sub create_table_REFIDDOC {
410 0     0 0   my $dbh = shift;
411 0           my $table = "EDTK_REFIDDOC";
412              
413 0           my $sql = "CREATE TABLE $table";
414 0           $sql .= "( ED_REFIDDOC VARCHAR2(20) NOT NULL";
415 0           $sql .= ", ED_CORP VARCHAR2(8) NOT NULL"; # Entity related to the document
416 0           $sql .= ", ED_CATDOC CHAR NOT NULL";
417 0           $sql .= ", ED_PORTADR CHAR NOT NULL";
418 0           $sql .= ", ED_MASSMAIL CHAR NOT NULL";
419 0           $sql .= ", ED_EDOCSHARE CHAR NOT NULL";
420 0           $sql .= ", ED_TYPED CHAR NOT NULL";
421 0           $sql .= ", ED_MODEDI CHAR NOT NULL";
422 0           $sql .= ", ED_PGORIEN VARCHAR2(2)";
423 0           $sql .= ", ED_FORMATP VARCHAR2(2)";
424 0           $sql .= ", ED_REFIMP_P1 VARCHAR2(16)";
425 0           $sql .= ", ED_REFIMP_PS VARCHAR2(16)";
426 0           $sql .= ", ED_REFIMP_REFIDDOC VARCHAR2(64)";
427 0           $sql .= ", ED_MAIL_REFERENT VARCHAR2(300)"; # referent mail for doc validation
428             # $sql .= ", PRIMARY KEY (ED_REFIDDOC, ED_CORP, ED_CATDOC)"
429 0           $sql .= " )";
430              
431 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
432             }
433              
434              
435             sub create_table_SUPPORTS {
436 0     0 0   my $dbh = shift;
437 0           my $table = "EDTK_SUPPORTS";
438              
439 0           my $sql = "CREATE TABLE $table";
440 0           $sql .= "( ED_REFIMP VARCHAR2(16) UNIQUE"; # ALTER table EDTK_SUPPORTS modify ED_REFIMP VARCHAR2(16) UNIQUE;
441 0           $sql .= ", ED_TYPIMP CHAR NOT NULL";
442 0           $sql .= ", ED_FORMATP VARCHAR2(2) NOT NULL";
443 0           $sql .= ", ED_POIDSUNIT INTEGER NOT NULL";
444 0           $sql .= ", ED_FEUIMAX INTEGER";
445 0           $sql .= ", ED_POIDSMAX INTEGER";
446 0           $sql .= ", ED_BAC_INSERT INTEGER";
447 0           $sql .= ", ED_COPYGROUP VARCHAR2(16)";
448 0           $sql .= ", ED_OPTCTRL VARCHAR2(8)";
449 0           $sql .= ", ED_DEBVALID VARCHAR2(8)";
450 0           $sql .= ", ED_FINVALID VARCHAR2(8)";
451             # $sql .= ", PRIMARY KEY (ED_REFIMP, ED_TYPIMP)"
452 0           $sql .= " )";
453              
454 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
455             }
456              
457              
458             our @INDEX_COLS = (
459             # SECTION COMPOSITION DE L'INDEX
460             ['ED_REFIDDOC','VARCHAR2(20) NOT NULL'],# identifiant dans le référentiel de document
461             ['ED_IDLDOC', 'VARCHAR2(17) NOT NULL'],# Identifiant du document dans le lot de mise en page ED_SNGL_ID
462             ['ED_IDSEQPG', 'INTEGER NOT NULL'], # Sequence Numéro de séquence de page dans le lot de mise en page
463             ['ED_SEQDOC', 'INTEGER NOT NULL'], # Numéro de séquence du document dans le lot
464              
465             ['ED_CPDEST', 'VARCHAR2(10)'], # Code postal Destinataire ALTER table edtk_index modify ED_CPDEST VARCHAR2(10);
466             ['ED_VILLDEST','VARCHAR2(30)'], # Ville destinataire ALTER table edtk_index modify ED_VILLDEST VARCHAR2(30);
467             ['ED_IDDEST', 'VARCHAR2(25)'], # Identifiant du destinataire dans le système de gestion
468             ['ED_NOMDEST', 'VARCHAR2(38)'], # Nom destinataire ALTER table edtk_index modify ED_NOMDEST VARCHAR2(38);
469             ['ED_IDEMET', 'VARCHAR2(10)'], # identifiant de l'émetteur
470             ['ED_DTEDTION','VARCHAR2(8) NOT NULL'], # date d'édition, celle qui figure sur le document
471             ['ED_TYPPROD', 'CHAR'], # type de production associée au lot
472             ['ED_PORTADR', 'CHAR'], # indicateur de document porte adresse
473             ['ED_ADRLN1', 'VARCHAR2(38)'], # ligne d'adresse 1
474             ['ED_CLEGED1', 'VARCHAR2(20)'], # clef pour système d'archivage
475             ['ED_ADRLN2', 'VARCHAR2(38)'], # ligne d'adresse 2
476             ['ED_CLEGED2', 'VARCHAR2(20)'], # clef pour système d'archivage
477             ['ED_ADRLN3', 'VARCHAR2(38)'], # ligne d'adresse 3
478             ['ED_CLEGED3', 'VARCHAR2(20)'], # clef pour système d'archivage
479             ['ED_ADRLN4', 'VARCHAR2(38)'], # ligne d'adresse 4
480             ['ED_CLEGED4', 'VARCHAR2(20)'], # clef pour système d'archivage
481             ['ED_ADRLN5', 'VARCHAR2(38)'], # ligne d'adresse 5
482             ['ED_CORP', 'VARCHAR2(8) NOT NULL'],# société émettrice de la page ALTER table edtk_index modify ED_CORP VARCHAR2(8) NOT NULL;
483             ['ED_DOCLIB', 'VARCHAR2(32)'], # merge library compuset associée ? la page
484             ['ED_REFIMP', 'VARCHAR2(16)'], # référence de pr?-imprim? ou d'imprim? ou d'encart
485             ['ED_ADRLN6', 'VARCHAR2(38)'], # ligne d'adresse 6
486             ['ED_SOURCE', 'VARCHAR2(8) NOT NULL'], # Source de l'index
487             ['ED_OWNER', 'VARCHAR2(10)'], # propriétaire du document (utilisation en gestion / archivage de documents)
488             ['ED_HOST', 'VARCHAR2(32)'], # Hostname de la machine d'ou origine cette entrée
489             ['ED_IDIDX', 'VARCHAR2(7) NOT NULL'], # identifiant de l'index
490             ['ED_CATDOC', 'CHAR'], # catégorie de document
491             ['ED_CODRUPT', 'VARCHAR2(8)'], # code forçage de rupture ALTER table edtk_index modify ED_CODRUPT VARCHAR2(8);
492              
493             # SECTION LOTISSEMENT DE L'INDEX
494             ['ED_IDLOT', 'VARCHAR2(8)'], # identifiant du lot ALTER table EDTK_INDEX modify ED_IDLOT VARCHAR2(8) NOT NULL;
495             ['ED_SEQLOT', 'VARCHAR2(7)'], # identifiant du lot de mise sous plis (sous-lot) ALTER table EDTK_INDEX modify ED_SEQLOT VARCHAR2(7); update edtk_index set ed_seqlot = substr('1'|| ed_seqlot,-7);
496             ['ED_DTLOT', 'VARCHAR2(8)'], # date de la création du lot de mise sous plis
497             ['ED_IDFILIERE','VARCHAR2(5)'], # identifiant de la filière de production ALTER table EDTK_INDEX modify ED_IDFILIERE VARCHAR2(5);
498             ['ED_SEQPGDOC','INTEGER'], # numéro de séquence de page dans le document
499             ['ED_NBPGDOC', 'INTEGER'], # nombre de page (faces) du document
500             ['ED_POIDSUNIT','INTEGER'], # poids de l'imprim? ou de l'encart en mg
501             ['ED_NBENC', 'INTEGER'], # nombre d'encarts du doc ALTER table EDTK_INDEX add ED_NBENC integer;
502             ['ED_ENCPDS', 'INTEGER'], # poids des encarts du doc ALTER table EDTK_INDEX add ED_ENCPDS INTEGER;
503             ['ED_BAC_INSERT','INTEGER'], # Appel de bac ou d'insert
504              
505             # SECTION EDITION DE L'INDEX
506             ['ED_TYPED', 'CHAR'], # type d'édition
507             ['ED_MODEDI', 'CHAR'], # mode d'édition
508             ['ED_FORMATP', 'VARCHAR2(2)'], # format papier
509             ['ED_PGORIEN', 'VARCHAR2(2)'], # orientation de l'édition
510             ['ED_FORMFLUX','VARCHAR2(3)'], # format du flux d'édition
511             # ['ED_FORMDEF', 'VARCHAR2(8)'], # Formdef AFP
512             # ['ED_PAGEDEF', 'VARCHAR2(8)'], # Pagedef AFP
513             # ['ED_FORMS', 'VARCHAR2(8)'], # Forms
514              
515             # SECTION PLI DE L'INDEX
516             ['ED_IDPLI', 'INTEGER'], # identifiant du pli
517             ['ED_NBDOCPLI','INTEGER NOT NULL'], # nombre de documents du pli
518             ['ED_NUMPGPLI','INTEGER NOT NULL'], # numéro de la page (face) dans le pli
519             ['ED_NBPGPLI', 'INTEGER'], # nombre de pages (faces) du pli
520             ['ED_NBFPLI', 'INTEGER'], # nombre de feuillets du pli
521             ['ED_LISTEREFENC','VARCHAR2(64)'], # liste des encarts du pli
522             ['ED_PDSPLI', 'INTEGER'], # poids du pli en mg
523             ['ED_TYPOBJ', 'CHAR'], # type d'objet dans le pli xxxxxx conserver ?
524             ['ED_STATUS', 'VARCHAR2(8)'], # status de lotissement (date de remise en poste ou status en fonction des versions) # ALTER TABLE EDTK_INDEX ADD ED_STATUS VARCHAR2(8); # attention très lourd a éxécuter ne pas faire en prod : UPDATE EDTK_INDEX SET ED_STATUS = ED_DTPOSTE;
525             ['ED_DTPOSTE', 'VARCHAR2(8)'] # à supprimer : status de lotissement (date de remise en poste ou status en fonction des versions) ALTER TABLE edtk_index rename ED_DTPOSTE to ED_STATUS VARCHAR2(8);
526              
527             );
528              
529              
530             sub create_table_PARA {
531 0     0 0   my $dbh = shift;
532 0           my $table = "EDTK_TEST_PARA";
533              
534 0           my $sql = "CREATE TABLE $table";
535 0           $sql .= "( ED_PARA_REFIDDOC VARCHAR2(20) NOT NULL";
536 0           $sql .= ", ED_PARA_CORP VARCHAR2(8) NOT NULL"; # Entity related to the document
537 0           $sql .= ", ED_ID INTEGER NOT NULL"; #
538 0           $sql .= ", ED_TSTAMP VARCHAR2(14) NOT NULL"; # Timestamp of event
539 0           $sql .= ", ED_TEXTBLOC VARCHAR2(512)";
540             # $sql .= ", PRIMARY KEY (ED_PARA_REFIDDOC, ED_PARA_CORP)"
541 0           $sql .= " )";
542              
543 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
544             }
545              
546              
547             sub create_table_DATAGROUPS {
548 0     0 0   my $dbh = shift;
549 0           my $table = "EDTK_TEST_DATAGROUPS";
550              
551 0           my $sql = "CREATE TABLE $table";
552 0           $sql .= "( ED_DGPS_REFIDDOC VARCHAR2(20) NOT NULL";
553 0           $sql .= ", ED_ID INTEGER NOT NULL";
554 0           $sql .= ", ED_DATA VARCHAR2(64)";
555 0           $sql .= " )";
556              
557 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
558             }
559              
560              
561             sub create_table_ACQUIT {
562 0     0 0   my $dbh = shift;
563 0           my $table = "EDTK_ACQ";
564              
565 0           my $sql = "CREATE TABLE $table";
566 0           $sql .= "( ED_SEQLOT VARCHAR2(7) NOT NULL"; # identifiant du lot de mise sous plis (sous-lot) update edtk_acq set ed_seqlot = substr('1'|| ed_seqlot,-7);
567 0           $sql .= ", ED_LOTNAME VARCHAR2(16) NOT NULL"; # alter table EDTK_LOTS add ED_LOTNAME VARCHAR2(16); alter table EDTK_LOTS modify ED_LOTNAME VARCHAR2(16) NOT NULL;
568 0           $sql .= ", ED_DTPRINT VARCHAR2(8)"; # date de d'imrpession
569 0           $sql .= ", ED_DTPOST VARCHAR2(8) NOT NULL"; # date de remise en poste
570 0           $sql .= ", ED_NBFACES INTEGER NOT NULL"; # nombre de faces du lot (faces comptables, comprenant les faces blanches de R°/V°)
571 0           $sql .= ", ED_NBPLIS INTEGER NOT NULL"; # nombre de documents du pli
572 0           $sql .= ", ED_DTPOST2 VARCHAR2(8)"; # date de remise en poste
573 0           $sql .= ", ED_DTCHECK VARCHAR2(8)"; # date de check
574 0           $sql .= ", ED_STATUS VARCHAR2(4)"; # check status
575             # $sql .= ", PRIMARY KEY (ED_SEQLOT, ED_LOTNAME)"
576 0           $sql .= " )";
577              
578 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or die $dbh->errstr;
579             }
580              
581              
582             sub create_table_INDEX {
583 0     0 0   my ($dbh, $table) = @_;
584              
585 0           my $sql = "CREATE TABLE $table ("
586 0           . join(', ', map {"$$_[0] $$_[1]"} @INDEX_COLS) . ", "
587             . " PRIMARY KEY (ED_IDLDOC, ED_SEQDOC, ED_IDSEQPG)" # rajouter ED_SEQLOT ?
588             . " )";
589              
590 0 0         $dbh->do(_sql_fixup($dbh, $sql)) or warn "INFO : " . $dbh->errstr . "\n";
591             }
592              
593              
594             sub create_lot_sequence {
595 0     0 0   my $dbh = shift;
596              
597 0           $dbh->do('CREATE SEQUENCE EDTK_IDLOT MINVALUE 0 MAXVALUE 999 CYCLE');
598             }
599              
600              
601             sub create_SCHEMA {
602 0     0 0   my ($dbh, $table, $maxkeys) = @_;
603 0           my $cfg = config_read('EDTK_DB');
604              
605 0           create_lot_sequence($dbh);
606 0           create_table_INDEX($dbh, $cfg->{'EDTK_DBI_OUTMNGR'});
607 0           $dbh->do('CREATE INDEX ed_seqlot_idx ON EDTK_INDEX (ed_seqlot)');
608             # vérifier les propositions de clés primaires et les index (attention à ne pas faire n'importe quoi)
609 0           create_table_TRACKING($dbh, $cfg->{'EDTK_DBI_TRACKING'}, $cfg->{'EDTK_MAX_USER_KEY'});
610            
611 0           create_table_ACQUIT($dbh);
612 0           create_table_FILIERES($dbh);
613 0           create_table_LOTS($dbh);
614 0           create_table_REFIDDOC($dbh);
615 0           create_table_SUPPORTS($dbh);
616             }
617              
618              
619             sub _sql_fixup {
620 0     0     my ($dbh, $sql) = @_;
621              
622 0 0         if ($dbh->{'Driver'}->{'Name'} ne 'Oracle') {
623 0           $sql =~ s/VARCHAR2 *(\(\d+\))/VARCHAR$1/g;
624             }
625 0           return $sql;
626             }
627              
628             1;
629             #
630             #
631             #10g SOC5> SELECT *
632             # 2 FROM v$version;
633             #
634             #BANNER
635             #----------------------------------------------------------------
636             #Oracle DATABASE 10g Enterprise Edition Release 10.1.0.3.0 - Prod
637             #PL/SQL Release 10.1.0.3.0 - Production
638             #CORE 10.1.0.3.0 Production
639             #TNS FOR 32-bit Windows: Version 10.1.0.3.0 - Production
640             #NLSRTL Version 10.1.0.3.0 - Production
641             #
642             #5 ligne(s) sélectionnée(s).
643             #
644             #10g SOC5> DESC dvp
645             # Nom NULL ? Type
646             # ------------------------------- -------- ----
647             # COL_NUM NUMBER(12)
648             #
649             #10g SOC5> SELECT *
650             # 2 FROM dvp;
651             #
652             # COL_NUM
653             #----------
654             # 10
655             # 12
656             # 1000000
657             # 5923146
658             #
659             #4 ligne(s) sélectionnée(s).
660             #
661             #10g SOC5> ALTER TABLE dvp RENAME COLUMN col_num TO col_renommee;
662             #
663             #TABLE modifiée.
664             #
665             #10g SOC5> DESC dvp
666             # Nom NULL ? Type
667             # ------------------------------- -------- ----
668             # COL_RENOMMEE NUMBER(12)
669             #