1####################################################################################################### 2# 3# Perl module: XML::XMLtoDBMS 4# 5# By Nick Semenov, nsemenov@yahoo.com 6# perl port of Java package XML-DBMS v1.0 (de.tudarmstadt.ito.*) by Ron Bourret, rbourret@hotmail.com 7# 8####################################################################################################### 9# 10# http://www.informatik.th-darmstadt.de/DVS1/staff/bourret/xmldbms/xmldbms.htm 11####################################################################################################### 12# 13# fixes: 14# 15# 2000-07-18 serializeNode un-escaping 16# 2000-07-.. fixed complex Order by clause (was not adding all the columns) 17# 2000-08-24 added where clause to retrieveDocument function 18# 2000-08-24 fixed date conversion (was not reaching check for date format) 19# 2000-08-25 added startindex, numcolumns to the retrieve multipage documents 20# 2000-09-12 fixed SQL error handling; remove duplicate keys when there is subquery 21# 2000-09-18 added sorting order direction for root/pseudoroot table 22# 2000-09-26 null values in the key columns are now supported - reversed because of SqlFlex not supporting (? = NULL) binding 23# 2000-10-02 added return of the result set size when using range queries (start_index, length) 24# 2001-02-13 v 1.01 added missing Row::anyNull function 25# 2001-05-17 v.1.01.1 fixed convertDateString with more precise datetime data recognition 26# 2001-05-29 v.1.01.2 order column processing in processTableMaps fixed 27# 2001-05-29 v.1.02 replaced XML::DOM with XML::LibXML (50% performance gain in DOM creation) 28# 2001-11-12 v.1.03 Oracle date format recognized. 29# fix for ".00." ODBC integer format, removed XMLtoDBMS::Parameters 30# added XSLT-type parameters support, filtering of resultsets, and limited XPath-type node level conrol (see sample2.map) 31# 32# 33####################################################################################################### 34package XML::XMLtoDBMS; 35####################################################################################################### 36BEGIN 37{ 38 require XML::Parser::PerlSAX; 39 40 import XML::XMLtoDBMS::MapFactory; 41 import XML::XMLtoDBMS::DocumentInfo; 42 import XML::XMLtoDBMS::KeyGenerator; 43 import XML::XMLtoDBMS::Parameters; 44 import XML::XMLtoDBMS::Order; 45 import XML::XMLtoDBMS::Row; 46 47 $VERSION = '1.02'; 48 $NAME = 'XML::XMLtoDBMS'; 49 50 @ISA = qw( Exporter ); 51} 52 53#use strict; 54use Carp; 55use DBI; 56use XML::LibXML; 57use Time::Local; 58use Date::Format; 59use Date::Parse; 60 61use vars qw (@ISA $VERSION $NAME %ClassMapTypes %PropertyMapTypes %ColumnMapTypes 62 %TableMapTypes %char_entities); 63 64 65%ClassMapTypes = (ToRootTable => 1, ToClassTable => 2, IgnoreRoot => 3, PassThrough => 4); 66%PropertyMapTypes = (ToColumn => 1, ToPropertyTable => 2); 67%ColumnMapTypes = (ToAttribute => 1, ToElementType => 2, ToPCData => 3); 68%TableMapTypes = (ClassTable => 1, PropertyTable => 2); 69%char_entities = ( 70 "\x09" => '	', 71 "\x0a" => ' ', 72 "\x0d" => ' ', 73 '&' => '&', 74 '<' => '<', 75 '>' => '>', 76 '"' => '"', 77); 78 79sub new 80{ 81 my $type = shift; 82 my $dbh = shift; 83 my $self = { DBh => $dbh }; 84 bless $self, $type; 85} 86 87sub storeDocument 88{ 89 my $self = shift; 90 91 croak "No map was set yet" if !defined $self->{Map}; 92 93 if (scalar(@_) == 1 and ref($_[0]) eq "XML::LibXML::Document") 94 { 95 $self->{Doc} = shift; 96 } 97 else 98 { 99 my $args = {@_}; 100 $self->{Doc} = $self->openDocument($args->{Source}); 101 } 102 103 #my $dateFormat = $self->{Map}{DateFormat}; 104 #my $timeFormat = $self->{Map}{TimeFormat}; 105 #my $timestampFormat = $self->{Map}{TimestampFormat}; 106 107 #$self->{Parameters} = new XML::XMLtoDBMS::Parameters(DateFormat => $dateFormat, TimeFormat => $timeFormat, TimestampFormat => $timestampFormat); 108 $self->{Parameters} = $self->{Map}{Parameters}; 109 110 $self->{KeyGenerator} = new XML::XMLtoDBMS::KeyGenerator($self->{DBh}); 111 112 $self->processRoot($self->{Doc}->getDocumentElement, $self->{Map}); 113 return $self->{Doc}; 114} 115 116 117sub openDocument 118{ 119 my $self = shift; 120 my $source = shift; 121 my $parser = new XML::LibXML; 122 123 if (exists $source->{File}) 124 { 125 return $parser->parse_file($source->{File}); 126 } 127 elsif (exists $source->{String}) 128 { 129 return $parser->parse_string($source->{String}); 130 } 131 else 132 { 133 croak "storeDocument has unknown argument" ; 134 } 135} 136 137sub setMap 138{ 139 my $self = shift; 140 my $mapFileName = shift; 141 142 $self->{Map}->destroy if defined $self->{Map}; 143 144 my $mapfactory = new XML::XMLtoDBMS::MapFactory(); 145 $self->{Map} = $mapfactory->createMap($mapFileName, $self->{DBh}); 146 return $self->{Map}; 147} 148 149sub destroy 150{ 151 my $self = shift; 152 $self->{Map}->destroy if defined $self->{Map}; 153} 154 155sub retrieveDocument 156{ 157 my ($self, $tableName, $keys, $params, $startindex, $numrows, $total) = @_; 158 my ($key, $value); 159 160 croak "No map was set yet" if !defined $self->{Map}; 161 162 #$self->{Doc}->dispose if defined $self->{Doc}; 163 164 $self->{Doc} = new XML::LibXML::Document; 165 #make then point to one location 166 $self->{Parameters} = $self->{Map}{Parameters}; 167 if (defined $params) 168 { 169 while(($key, $value) = each(%{$params})) 170 { 171 if (exists $self->{Parameters}{$key}) 172 { 173 $self->{Parameters}{$key} = $value ; 174 } 175 else 176 { 177 croak "parameter $key is not declared in the map"; 178 } 179 } 180 } 181 182 #my $dateFormat = convertFormat($self->{Map}{DateFormat}); 183 #my $timeFormat = convertFormat($self->{Map}{TimeFormat}); 184 #my $timestampFormat = convertFormat($self->{Map}{TimestampFormat}); 185 #$self->{Parameters} = new XML::XMLtoDBMS::Parameters($params); 186 my $rootTableMap = $self->{Map}->getRootTableMap($tableName); 187 188 # This chunk is to execute range queries. 189 if (defined $startindex) 190 { 191 $startindex--; 192 $numrows = 1 if !defined $numrows or $numrows < 0 ; 193 my $lastindex = $startindex + $numrows - 1; 194 195 196 my $select = $self->{Map}->checkOutSelectStmt($rootTableMap->{TableMap}{Table}, 197 $rootTableMap->{CandidateKey}, 198 $rootTableMap->{OrderColumn}, 199 $rootTableMap->{Filter}, 1); 200 201 croak $self->{Map}{DB}->errstr 202 if !defined $select or !$select->execute(); 203 204 $keys = $select->fetchall_arrayref([0..$#{@{$rootTableMap->{CandidateKey}}}]); 205 $$total = @{$keys} if defined $total ; 206 @slice = @{$keys}[$startindex..$lastindex]; 207 my %saw; 208 undef %saw; 209 @slice= grep(!$saw{join('|',@{$_})}++, @slice); 210 $keys = \@slice; 211 212 } 213 214 if (defined $keys and ref($keys) eq 'ARRAY') 215 { 216 my $select = $self->{Map}->checkOutSelectStmt($rootTableMap->{TableMap}{Table}, 217 $rootTableMap->{CandidateKey}, 218 $rootTableMap->{OrderColumn}, 219 $rootTableMap->{Filter}) 220 if $keys > 0; 221 222 croak $self->{Map}{DB}->errstr if !defined $select; 223 foreach my $keyValues(@{$keys}) 224 { 225 last if !defined $keyValues; 226 #$self->{Parameters}->setParameters($select, $keyValues, $rootTableMap->{CandidateKey}); 227 $select->execute(@{$keyValues}) or croak $self->{DB}->errstr; 228 $self->processRootResultSet($rootTableMap, $select, $rootTableMap->{OrderColumn}, new XML::XMLtoDBMS::Order()); 229 #$self->{Map}->checkInSelectStmt($select); 230 } 231 return $self->{Doc}; 232 } 233 else 234 { 235 my $select = $self->{Map}->checkOutSelectStmt($rootTableMap->{TableMap}{Table}, 236 $keys, 237 $rootTableMap->{OrderColumn}, 238 $rootTableMap->{Filter}); 239 croak $self->{DB}->errstr if !defined $select or !$select->execute(); 240 $self->processRootResultSet($rootTableMap, $select, $rootTableMap->{OrderColumn}, new XML::XMLtoDBMS::Order()); 241 #$self->{Map}->checkInSelectStmt($select); 242 return $self->{Doc}; 243 } 244} 245 246sub doubleArray 247{ 248 $array = shift; 249 my @newarray; 250 251 foreach (@{$array}) 252 { 253 push @newarray, $_; 254 push @newarray, $_; 255 } 256 return \@newarray unless wantarray; 257 @newarray; 258} 259 260sub processRootResultSet 261{ 262 my ($self, $rootTableMap, $rs, $orderColumn, $parentOrder) = @_; 263 264 my $row = new XML::XMLtoDBMS::Row(); 265 my $firstRow = 1; 266 267 #Process the root result set. 268 my $parent = $self->addIgnoredRoot($rootTableMap); 269 270 $self->processClassResultSet($parent, $rootTableMap->{TableMap}, $rs, $orderColumn, $parentOrder); 271} 272 273sub processClassResultSet 274{ 275 my ($self, $parent, $rsMap, $rs, $orderColumn, $parentOrder) = @_; 276 277 my $row = new XML::XMLtoDBMS::Row(); 278 my $childOrder = new XML::XMLtoDBMS::Order(); 279 my $resRow; 280 281 #We currently don't support pass-through elements. However, this will 282 #be the place to add them in the future. 283 #parent = addPassThroughElements(parent, rsMap); 284 285 #while ($resRow = $rs->fetch) 286 287 $resRow = $rs->fetchall_arrayref; 288 $rs->finish; 289 290 foreach (@{$resRow}) 291 { 292 #print "Processing class $rsMap->{ElementType}\n"; 293 294 #Create an element node for the row and insert it into the 295 #parent node. 296 #@{$row->{ColumnValues}} = @{$resRow}; 297 298 #fix for DBI::ODBC - integer values are returned with ".00." at the end - cut them off 299 foreach (@{$_}) { s/\.00\.//g if $_}; 300 @{$row->{ColumnValues}} = @{$_}; 301 302 my $child = $self->{Doc}->createElement($rsMap->{ElementType}); 303 $parentOrder->insertChild($parent, $child, getOrderValue($row, $orderColumn), $rsMap->{Level}); 304 305 #Process the columns in the row, then process the related tables 306 #for the row. 307 308 $childOrder->clear; 309 $self->processColumns($row, $rsMap->{ColumnMaps}, $child, $childOrder); 310 $self->processRelatedTables($row, $rsMap, $child, $childOrder); 311 } 312} 313 314sub processColumns 315{ 316 my ($self, $row, $columnMaps, $parent, $parentOrder) = @_; 317 318 foreach (@{$columnMaps}) 319 { 320 $self->processColumn($row, $_, $parent, $parentOrder); 321 } 322} 323 324sub processColumn 325{ 326 my ($self, $row, $columnMap, $parent, $parentOrder) = @_; 327 328 #Get the data value. If the data value is a null reference, then the 329 #corresponding column is NULL. In this case, we simply don't create 330 #the element/attribute/PCDATA. 331 332 my $dataValue = $self->getDataValue($row, $columnMap->{Column}); 333 334 return if !defined $dataValue; 335 336 my $orderValue = $self->getOrderValue($row, $columnMap->{OrderColumn}); 337 my ($property, $child, $pcData); 338 339 if ($columnMap->{Type} == $ColumnMapTypes{ToElementType}) 340 { 341 $property = $columnMap->{Property}; 342 $child = $self->{Doc}->createElement($property); 343 $parentOrder->insertChild($parent, $child, $orderValue); 344 $pcData = $self->{Doc}->createTextNode($dataValue); 345 $child->appendChild($pcData); 346 } 347 elsif ($columnMap->{Type} == $ColumnMapTypes{ToAttribute}) 348 { 349 #Set the attribute. Note that if the attribute is multi-valued, we 350 #get the current attribute value first, then append the new value 351 #to it. Because multi-valued attributes must be stored in a 352 #property table, we don't need to worry about the order column -- 353 #the result set over the property table is already sorted. 354 $property = $columnMap->{Property}; 355 if (!$columnMap->{MultiValued}) 356 { 357 $parent->setAttribute($property, $dataValue); 358 } 359 else 360 { 361 my $string = $parent->getAttribute($property); 362 if (length($string)) 363 { 364 $string .= " "; 365 } 366 $parent->setAttribute($property, $string . $dataValue); 367 } 368 } 369 elsif ($columnMap->{Type} = $ColumnMapTypes{ToPCData}) 370 { 371 $pcData = $self->{Doc}->createTextNode($dataValue); 372 $parentOrder->insertChild($parent, $pcData, $orderValues); 373 } 374} 375 376sub processRelatedTables 377{ 378 my ($self, $row, $rsMap, $parent, $parentOrder) = @_; 379 my $select; 380 381 my $i = 0; 382 foreach (@{$rsMap->{RelatedTables}}) 383 { 384 $select = $self->{Map}->checkOutSelectStmtByTable($rsMap->{Table}{Number}, $i); 385 #$self->{Parameters}->setParameters($select, $row, $rsMap->{ParentKeys}[$i]); 386 my $params = $row->getColumnValues($rsMap->{ParentKeys}[$i]); 387 388 croak "select statement is not defined" if !defined $select; 389 390 croak $self->{Map}{DB}->errstr if !$select->execute(@{$params}); 391 392 if ($_->{Type} == $TableMapTypes{ClassTable}) 393 { 394 $self->processClassResultSet($parent, $_, $select, $rsMap->{OrderColumns}[$i], $parentOrder); 395 } 396 elsif ($_->{Type} == $TableMapTypes{PropertyTable}) 397 { 398 $self->processPropResultSet($parent, $_, $select, $parentOrder); 399 } 400 $self->{Map}->checkInSelectStmt($select, $rsMap->{Table}{Number}, $i++); 401 } 402} 403 404sub processPropResultSet 405{ 406 my ($self, $parent, $rsMap, $stmt, $parentOrder) = @_; 407 my $row = new XML::XMLtoDBMS::Row(); 408 my $resRow; 409 410 #while ($resRow = $rs->fetch) 411 $resRow = $stmt->fetchall_arrayref; 412 $stmt->finish; 413 414 foreach (@{$resRow}) 415 { 416 #@{$row->{ColumnValues}} = @{$resRow}; 417 @{$row->{ColumnValues}} = @{$_}; 418 $self->processColumns($row, $rsMap->{ColumnMaps}, $parent, $parentOrder); 419 } 420} 421 422sub getDataValue 423{ 424 my ($self, $row, $column) = @_; 425 my $datetime; 426 427 return undef if ! defined $row->{ColumnValues}[$column->{Number} - 1]; 428 my $value = $row->getColumnValue($column); 429 430 #reformatting of the date, time and timestamp should be done here. 431 432 if ($value =~ /^\d{2}[\/-]\d{2}[\/-](\d{2})?\d{2}\s*/ || 433 $value =~ /^\d{2}\-[A-Za-z]{3}\-(\d{2})?\d{2}\s*/ || 434 $value =~ /^\d{4}[\/-]\d{2}[\/-]\d{2}\s*/ ) 435 { 436 $datetime = str2time($value); 437 if ($datetime) 438 { 439 if ($') 440 { 441 $value = time2str($self->{Parameters}{TimestampFormat}, str2time($value)); 442 } 443 else 444 { 445 $value = time2str($self->{Parameters}{DateFormat}, str2time($value)); 446 } 447 } 448 } 449 return $value; 450} 451 452sub getOrderValue 453{ 454 my ($self, $row, $orderColumn) = @_; 455 456 return -1 if (!defined $orderColumn or !defined $row->{ColumnValues}[$orderColumn->{Number} - 1]); 457 return $row->{ColumnValues}[$orderColumn->{Number} - 1]; 458} 459 460sub addIgnoredRoot 461{ 462 my $self = shift; 463 my $rootMap = shift; 464 465 #If there is no ignored root element, simply return the current 466 #root element node. 467 return $self->{Doc} if !defined $rootMap->{IgnoredRootType}; 468 469 my $ignoredRootType = $rootMap->{IgnoredRootType}; 470 my $ignoredRoot = $self->{Doc}->getDocumentElement; 471 if (!defined $ignoredRoot) 472 { 473 $ignoredRoot = $self->{Doc}->createElement($ignoredRootType); 474 $self->{Doc}->setDocumentElement($ignoredRoot); 475 } 476 elsif ($ignoredRoot->getName ne $ignoredRootType) 477 { 478 croak "More than one ignored root element type specified: $ignoredRoot->getName and $ignoredRootType"; 479 } 480 return $ignoredRoot; 481} 482 483sub processRoot 484{ 485 my ($self, $root, $map) = @_; 486 487 my $docInfo = new XML::XMLtoDBMS::DocumentInfo(); 488 489 my $rootMap = $map->{RootClassMaps}{$root->getName}; 490 491 if (!defined $rootMap) 492 { 493 croak "Root element not mapped to root table or ignored: ". $root->getName; 494 } 495 496 if ($rootMap->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}) 497 { 498 $self->processRootElement($docInfo, $rootMap, $root, 1); 499 } 500 elsif ($rootMap->{ClassMap}{Type} == $ClassMapTypes{IgnoreRoot}) 501 { 502 my $childOrder = 1; 503 my $child = $root->getFirstChild; 504 505 while (defined $child) 506 { 507 if ($child->getType != XML_TEXT_NODE) 508 { 509 my $childMap = $rootMap->{ClassMap}{SubElementTypeMaps}{$child->getName}; 510 511 if (defined $childMap) 512 { 513 croak "If the root element is ignored, any mapped children must be mapped to class tables. " . $child->getName . " is not." 514 if $childMap->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}; 515 516 $self->processRootElement($docInfo, $childMap, $child, $childOrder); 517 } 518 $childOrder++; 519 } 520 $child = $child->getNextSibling; 521 } 522 } 523 else 524 { 525 croak "Root element must be mapped to a root table or ignored. " . $root->getName . " is not."; 526 } 527 #return $docInfo; 528 529} 530 531sub processRootElement 532{ 533 my ($self, $docInfo, $relatedClassMap, $root, $orderInParent) = @_; 534 my ($key, $keyColumns); 535 536 #print "Calling to process root element " . $root->getName ."\n"; 537 538 my $row = $self->createClassRow(undef, $relatedClassMap, $root, $orderInParent); 539 540 if (defined $relatedClassMap->{LinkInfo}) 541 { 542 $keyColumns = $relatedClassMap->{LinkInfo}{ChildKey}; 543 $key = $row->getColumnValues($keyColumns); 544 } 545 546 $docInfo->addInfo($relatedClassMap->{ClassMap}{Table}, $keyColumns, $key, $relatedClassMap->{OrderInfo}); 547} 548 549sub createClassRow 550{ 551 my $self = shift; 552 my $parentRow = shift; 553 my $rcm = shift; 554 my $classNode = shift; 555 my $orderInParent = shift; 556 557 my $fkChildren = []; 558 my $classRow = new XML::XMLtoDBMS::Row(Table => $rcm->{ClassMap}{Table}); 559 560 if ($rcm->{LinkInfo}{ParentKeyIsCandidate}) 561 { 562 setChildKey($parentRow, $classRow, $rcm->{LinkInfo}); 563 } 564 else 565 { 566 $self->generateChildKey($classRow, $rcm->{LinkInfo}); 567 } 568 569 #BUG! Notice that the order is always assumed to be in the child 570 #class table. The mapping language supports placing it in either 571 #the parent or child tables, but the code does not -- for more 572 #information, see the bug file. (When this bug is fixed, care 573 #must be taken with the root element. In this case, the order 574 #column is always in the "child" (root) table, regardless of what 575 #parentKeyIsCandidate says.) 576 577 generateOrder($classRow, $rcm->{OrderInfo}, $orderInParent); 578 $self->processAttributes($classRow, $rcm->{ClassMap}, $classNode); 579 $self->processChildren($classRow, $rcm->{ClassMap}, $classNode, $fkChildren); 580 $self->insertRow($rcm->{ClassMap}{Table}, $classRow); 581 $self->processFKNodes($classRow, $fkChildren); 582 return $classRow; 583} 584 585sub createPropRow 586{ 587 my ($self, $parentRow, $propMap, $propNode, $orderInParent) = @_; 588 589 #This method creates and inserts a row in a property table. If the 590 #key used to link the row to its parent is a candidate key in this 591 #table, it is generated if necessary. Otherwise, the candidate key 592 #from the parent is set in this table as a foreign key. 593 594 my $propRow = new XML::XMLtoDBMS::Row(Table => $propMap->{Table}); 595 596 if ($propMap->{LinkInfo}{ParentKeyIsCandidate}) 597 { 598 #If the candidate key linking this class to its parent class is 599 #in the parent's table, set that key in the child row now. Otherwise, 600 #generate the candidate key in the current row. 601 602 setChildKey($parentRow, $propRow, $propMap->{LinkInfo}); 603 } 604 else 605 { 606 generateChildKey($propRow, $propMap->{LinkInfo}); 607 } 608 609 #BUG! Notice that the order is always assumed to be in the property 610 #table. The mapping language supports placing it in either the 611 #parent or child tables, but the code does not -- for more 612 #information, see the bug file. 613 614 generateOrder($propRow, $propMap->{OrderInfo}, $orderInParent); 615 setPropertyColumn($propRow, $propMap->{Column}, $propNode); 616 insertRow($propMap->{Table}, $propRow); 617 return $propRow; 618} 619 620 621sub generateChildKey 622{ 623 my $self = shift; 624 my $childRow = shift; 625 my $linkInfo = shift; 626 my $keyGenerator = $self->{KeyGenerator}; 627 628 $childRow->setColumnValues($linkInfo->{ChildKey}, $keyGenerator->generateKey($childRow->{Table}, $linkInfo->{ChildKey})) 629 if ($linkInfo->{GenerateKey}); 630} 631 632sub generateParentKey 633{ 634 my ($self, $parentRow, $linkInfo) = @_; 635 636 #Generate the candidate key in the parent's table if: (a) it is 637 #supposed to be generated, and (b) it has not already been generated. 638 #The latter condition is necessary because the parent table may be 639 #linked with the same key to multiple child tables, so the key might 640 #have already been set when processing a different child. This code 641 #assumes that no key columns in the parent are nullable, so a null in 642 #any column indicates that the key has not been generated. 643 644 if ($linkInfo->{GenerateKey} and $parentRow->anyNull($linkInfo->{ParentKey})) 645 { 646 my $keyGenerator = $self->{KeyGenerator}; 647 $parentRow->setColumnValues($linkInfo->{ParentKey}, $keyGenerator->generateKey($parentRow->{Table}, $linkInfo->{ParentKey})); 648 } 649} 650 651sub generateOrder 652{ 653 my $row = shift; 654 my $orderInfo = shift; 655 my $orderInParent = shift; 656 657 map {$row->setColumnValue($_->{OrderColumn}, $orderInParent) if ($_->{GenerateOrder});} @{$orderInfo}; 658} 659 660sub processFKNodes 661{ 662 my ($self, $parentRow, $fkNodes) = @_; 663 my $fkNode; 664 665 #This method creates and inserts a row in a class or property table. 666 #The candidate key used to link the row to its parent is in the 667 #parent's table. 668 669 foreach $fkNode (@{$fkNodes}) 670 { 671 if (ref($fkNode->{Map}) eq 'XML::XMLtoDBMS::PropertyMap') 672 { 673 createPropRow($parentRow, $fkNode->{Map}, $fkNode->{Node}, $fkNode->{OrderInParent}); 674 } 675 else 676 { 677 $self->createClassRow($parentRow, $fkNode->{Map}, $fkNode->{Node}, $fkNode->{OrderInParent}); 678 } 679 } 680} 681 682sub setParentKey 683{ 684 my ($parentRow, $childRow, $linkInfo) = @_; 685 686 $parentRow->setColumnValues($linkInfo->{ParentKey}, $childRow->getColumnValues($linkInfo->{ChildKey})); 687} 688 689sub setChildKey 690{ 691 my ($parentRow, $childRow, $linkInfo) = @_; 692 693 $childRow->setColumnValues($linkInfo->{ChildKey}, $parentRow->getColumnValues($linkInfo->{ParentKey})); 694} 695 696sub processAttributes 697{ 698 my ($self, $elementRow, $classMap, $elementNode) = @_; 699 700 my $savedAttrs = []; 701 702 return if $elementNode->getType != XML_ELEMENT_NODE; 703 704 #replaces getAttributes from XML::DOM 705 my @attribs = $elementNode->findnodes('@*'); 706 return if @attribs == 0; 707 708 my ($attr, $attrMap, $attrOrder, $attributes); 709 #my $attribs = $elementNode->getAttributes; 710 711 for (my $i = 0; $i < $#attribs + 1; $i++) 712 { 713 $attr = $attribs[$i]; 714 $attrMap = $classMap->{AttributeMaps}{$attr->getName}; 715 716 next if !defined $attrMap; 717 718 $attrOrder = 1; 719 720 if ($attrMap->{MultiValued}) 721 { 722 #If the attribute is multi-valued, then process each value as a 723 #separate attribute. We construct fake attributes for this 724 #purpose; the names of these attributes are unimportant, as we 725 #already have the AttributeMap. Order refers to the order of the 726 #value in the attribute, not order of the attribute in the 727 #element (attributes are unordered). 728 729 my @attributes = split / /, $attr->getNodeValue; 730 731 foreach (@attributes) 732 { 733 my $fake = $self->{Doc}->createAttribute("fake"); 734 $fake->setNodeValue($_); 735 $self->processProperty($elementRow, $attrMap, $fake, $attrOrder, $savedAttrs); 736 $attrOrder++; 737 } 738 } 739 else 740 { 741 $self->processProperty($elementRow, $attrMap, $attr, $attrOrder, $savedAttrs); 742 } 743 } 744} 745 746sub processChildren 747{ 748 my ($self, $parentRow, $parentMap, $parentNode, $fkChildren) = @_; 749 750 my $child = $parentNode->getFirstChild; 751 my $childOrder = 1; 752 753 my $childMap; 754 755 while (defined $child) 756 { 757 if ($child->getType == XML_TEXT_NODE) 758 { 759 $childMap = $parentMap->{PCDataMap}; 760 } 761 elsif ($child->getType == XML_ELEMENT_NODE) 762 { 763 $childMap = $parentMap->{SubElementTypeMaps}{$child->getName}; 764 } 765 766 if (defined $childMap) 767 { 768 if (ref($childMap) eq 'XML::XMLtoDBMS::PropertyMap') 769 { 770 $self->processProperty($parentRow, $childMap, $child, $childOrder, $fkChildren); 771 } 772 elsif (ref($childMap) eq 'XML::XMLtoDBMS::RelatedClassMap') 773 { 774 $self->processRelatedClass($parentRow, $childMap, $child, $childOrder, $fkChildren); 775 } 776 #PASSTHROUGH! When we support pass-through elements, we will 777 #need to check if the child has been mapped as pass-through. 778 } 779 $child = $child->getNextSibling; 780 $childOrder++; 781 } 782} 783 784sub insertRow 785{ 786 my ($self, $table, $row) = @_; 787 my $p = $self->{Map}->checkOutInsertStmt($table); 788 789 if (defined $p) 790 { 791 $self->setParameters($p, $row, $table->{Columns}); 792 $p->execute() or croak $self->{Map}{DB}->errstr; 793 $self->{Map}->checkInInsertStmt($p, $table); 794 } 795 else 796 { 797 croak "SQL statement failed"; 798 } 799} 800 801sub setParameters 802{ 803 my ($self, $preparedStmt, $row, $columns) = @_; 804 my $i = 0; 805 806 if (ref($row) eq 'XML::XMLtoDBMS::Row') 807 { 808 foreach (@{$columns}) 809 { 810 $preparedStmt->bind_param(++$i, $row->getColumnValue($_)); 811 } 812 } 813 else 814 { 815 croak "Not a row passes to set parameters"; 816 } 817} 818 819 820sub processProperty 821{ 822 my ($self, $parentRow, $propMap, $propNode, $orderInParent, $fkNodes) = @_; 823 824 if ($propMap->{Type} == $PropertyMapTypes{ToColumn}) 825 { 826 generateOrder($parentRow, $propMap->{OrderInfo}, $orderInParent); 827 $self->setPropertyColumn($parentRow, $propMap->{Column}, $propNode); 828 } 829 elsif($propMap->{Type} == $PropertyMapTypes{ToPropertyTable}) 830 { 831 if ($propMap->{LinkInfo}{ParentKeyIsCandidate}) 832 { 833 #If the key linking the class table to the property table is 834 #a candidate key in the class table and a foreign key in the 835 #property table, generate that key now and save the node 836 #for later processing (see FKNode). 837 838 $self->generateParentKey($parentRow, $propMap->{LinkInfo}), 839 push @{$fkNodes}, {Node => $propNode, 840 Map => $propMap, 841 OrderInParent => $orderInParent} 842 } 843 else 844 { 845 #If the key linking the class table to the property table is 846 #a candidate key in the property table and a foreign key in the 847 #class table, create the row now, then set the foreign key in 848 #the parent (class) table. 849 850 my $propRow = createPropRow(undef, $propMap, $propNode, $orderInParent); 851 setParentKey($parentRow, $propRow, $propMap->{LinkInfo}); 852 } 853 } 854} 855 856sub processRelatedClass 857{ 858 my ($self, $parentRow, $rcm, $classNode, $orderInParent, $fkNodes) = @_; 859 my $nodeName; 860 861 if ($rcm->{ClassMap}{Type} == $ClassMapTypes{ToClassTable}) 862 { 863 if ($rcm->{LinkInfo}{ParentKeyIsCandidate}) 864 { 865 #If the key linking the class table to the related class table 866 #is a candidate key in the class table and a foreign key in the 867 #related class table, generate that key now and save the node 868 #for later processing (see FKNode). 869 870 $self->generateParentKey($parentRow, $rcm->{LinkInfo}); 871 push @{$fkNodes}, {Node => $classNode, 872 Map => $rcm, 873 OrderInParent => $orderInParent}; 874 } 875 else 876 { 877 #If the key linking the class table to the related class table 878 #is a candidate key in the related class table and a foreign 879 #key in the class table, create the row now, then set the 880 #foreign key in the parent (class) table. 881 882 my $classRow = $self->createClassRow(undef, $rcm, $classNode, $orderInParent); 883 setParentKey($parentRow, $classRow, $rcm->{LinkInfo}); 884 } 885 } 886 elsif ($rcm->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}) 887 { 888 $nodeName = $classNode->getName; 889 croak "Non-root element mapped to root table: $nodeName" 890 } 891 elsif ($rcm->{ClassMap}{Type} == $ClassMapTypes{IgnoreRoot}) 892 { 893 $nodeName = $classNode->getName; 894 croak "Non-root element ignored: $nodeName" 895 } 896 elsif ($rcm->{ClassMap}{Type} == $ClassMapTypes{PassThrough}) 897 { 898 $nodeName = $classNode->getName; 899 croak "Pass-through not implemented yet: $nodeName" 900 } 901 else 902 { 903 $nodeName = $classNode->getName; 904 croak "Node map is of unknown type : $nodeName" 905 } 906} 907 908sub _escape { 909 #my $self = shift; 910 my $string = shift; 911 912 $string =~ s/([\x09\x0a\x0d&<>"])/$char_entities{$1}/ge; 913 return $string; 914} 915 916sub setPropertyColumn 917{ 918 my ($self, $propRow, $propColumn, $propNode) = @_; 919 my ($string, $convertedString); 920 921 if ($propNode->getType == XML_ELEMENT_NODE) 922 { 923 map 924 {$string .= $_->toString 925 if $_->getType == XML_TEXT_NODE or 926 $_->getType == XML_ELEMENT_NODE;} 927 $propNode->getChildnodes(); 928 } 929 else 930 { 931 $string = $propNode->getData; 932 } 933 934 #If empty strings are treated as NULLs, then check the length of 935 #the property value and, if it is 0, set the value to null, which 936 #is later interpreted as NULL. 937 938 if ($self->{Map}->{EmptyStringIsNull}) 939 { 940 if (length($string) == 0) 941 { 942 $string = undef; 943 } 944 } 945 946 $convertedString = convertDateString($self->{Parameters}{TimestampFormat}, $string); 947 return $propRow->setColumnValue($propColumn, $convertedString) 948 if $convertedString; 949 $convertedString = convertDateString($self->{Parameters}{DateFormat}, $string); 950 return $propRow->setColumnValue($propColumn, $convertedString) 951 if $convertedString; 952 $convertedString = convertDateString($self->{Parameters}{TimeFormat}, $string); 953 return $propRow->setColumnValue($propColumn, $convertedString) 954 if $convertedString; 955 956 $propRow->setColumnValue($propColumn, $string); 957} 958 959sub convertDateString 960{ 961 my $fmtStr = shift; 962 my $string = shift; 963 $string =~ s/\s*$//; 964 965 return undef unless (length($fmtStr) == length($string)) ; 966 967 my $sRE = $fmtStr; 968 969 $sRE =~ s/YY/\\d{2}/ if (not $sRE =~ s/YYYY/\\d{4}/); 970 $sRE =~ s/MM/\\d{2}/; 971 $sRE =~ s/DD/\\d{2}/; 972 $sRE =~ s/hh/\\d{2}/; 973 $sRE =~ s/mm/\\d{2}/; 974 $sRE =~ s/ss/\\d{2}/; 975 $sRE =~ s/AM/(AM|PM)/; 976 977 return undef unless($string =~ /^($sRE)$/); 978 979 my ($year, $month, $day, $hour, $minute, $second); 980 981 my $yearIndex4 = index($fmtStr, 'YYYY'); 982 my $yearIndex2 = index($fmtStr, 'YY') if $yearIndex4 == -1; 983 my $monthIndex = index($fmtStr, 'MM'); 984 my $dayIndex = index($fmtStr, 'DD'); 985 my $hourIndex = index($fmtStr, 'hh'); 986 my $minuteIndex = index($fmtStr, 'mm'); 987 my $secondIndex = index($fmtStr, 'ss'); 988 my $AMPMIndex = index($fmtStr, 'PM'); 989 990 if ($yearIndex4 != -1) { 991 $year = substr($string, $yearIndex4, 4); 992 } elsif ($yearIndex2 != -1) { 993 $year = substr($string, $yearIndex2, 2); 994 } 995 996 $month = substr($string, $monthIndex, 2) - 1 if $monthIndex != -1; 997 $day = substr($string, $dayIndex, 2) if $dayIndex != -1; 998 999 if ($hourIndex != -1) { 1000 $hour = substr($string, $hourIndex, 2); 1001 if (substr($string, $AMPMIndex, 2) eq 'PM') { 1002 #print 'a'.$hour; 1003 $hour += 12 unless($hour == 12); 1004 } 1005 if (substr($string, $AMPMIndex, 2) eq 'AM') { 1006 #print 'b'.$hour; 1007 $hour -= 12 if $hour == 12; 1008 } 1009 } 1010 1011 $minute = substr($string, $minuteIndex, 2) if $minuteIndex != -1; 1012 $second = substr($string, $secondIndex, 2) if $secondIndex != -1; 1013 1014 my @lt = localtime(time); 1015 1016 $month = $lt[4] 1017 unless(defined $month); 1018 1019 $day = $lt[3] 1020 unless(defined $day); 1021 1022 $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5] 1023 unless(defined $year); 1024 1025 $hour ||= 0 unless(defined $hour); 1026 $minute ||= 0 unless(defined $minute); 1027 $second ||= 0 unless(defined $second); 1028 1029 return undef 1030 unless($month <= 11 && $day >= 1 && $day <= 31 1031 && $hour <= 23 && $minute <= 59 && $second <= 59); 1032 1033 my $result = timelocal($second, $minute, $hour, $day, $month, $year); 1034 1035 return undef unless(defined $result); 1036 1037 return time2str("%m/%d/%Y", $result); 1038 1039 #disabled for AcctFlex date field. 1040 #if ($hour + $minute + $second == 0){ 1041 # return time2str("%m/%d/%Y", $result); 1042 #} else { 1043 # return time2str("%m/%d/%Y %X", $result); 1044 #} 1045} 1046 1047###################################################################### 1048package XML::XMLtoDBMS::KeyGenerator; 1049###################################################################### 1050#use strict; 1051sub new 1052{ 1053 my $type = shift; 1054 #my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1055 my $self = {DBh => shift}; 1056 bless $self, $type; 1057 $self->initialize; 1058 return $self; 1059} 1060 1061sub initialize 1062{ 1063 my $self = shift; 1064} 1065 1066sub generateKey 1067{ 1068 my ($self, $table, $childKey) = @_; 1069 1070 my $tableName = $table->{Name}; 1071 my $columnName = $childKey->[0]->{Name}; 1072 1073 my $selectString = "select max($columnName) from $tableName"; 1074 1075 my $maxValue = $self->{DBh}->selectrow_array($selectString); 1076 my $newValue = $maxValue + 1; 1077 $newValue = ' 'x(length($maxValue)-length($newValue)) . $newValue; 1078 #print $newValue . "\n"; 1079 return [$newValue]; 1080} 1081 1082###################################################################### 1083package XML::XMLtoDBMS::DocumentInfo; 1084###################################################################### 1085#use strict; 1086sub new 1087{ 1088 my $type = shift; 1089 my $self = {Tables => [], KeyColumns => [], Keys => [], OrderColumns => []}; 1090 return bless $self, $type; 1091} 1092 1093sub addInfo 1094{ 1095 my $self = shift; 1096 push @{$self->{Tables}}, shift; 1097 push @{$self->{KeyColumns}}, shift; 1098 push @{$self->{Key}}, shift; 1099 push @{$self->{OrderColumns}}, shift; 1100} 1101 1102###################################################################### 1103package XML::XMLtoDBMS::Row; 1104###################################################################### 1105#use strict; 1106sub new 1107{ 1108 my $type = shift; 1109 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1110 $self->{ColumnValues} = []; 1111 return bless $self, $type; 1112} 1113 1114sub setColumnValue 1115{ 1116 my ($self, $column, $value) = @_; 1117 $self->{ColumnValues}[$column->{Number} - 1] = $value; 1118 1119} 1120 1121sub setColumnValues 1122{ 1123 my ($self, $columns, $values) = @_; 1124 my $i = 0; 1125 1126 foreach (@{$columns}) 1127 { 1128 $self->{ColumnValues}[$_->{Number} - 1] = $values->[$i++]; 1129 } 1130} 1131 1132sub getColumnValue 1133{ 1134 my ($self, $column) = @_; 1135 my $value = $self->{ColumnValues}[$column->{Number} - 1]; 1136 $value =~ s/\s+$// if $value; 1137 #print "getting column value $value\n"; 1138 return $value; 1139} 1140 1141sub getColumnValues 1142{ 1143 my ($self, $columns) = @_; 1144 my $values = []; my $i = 0; 1145 push @{$values}, $self->getColumnValue($columns->[$i++]) 1146 foreach(@{$columns}); 1147 return $values; 1148} 1149 1150sub anyNull 1151{ 1152 my ($self, $columns) = @_; 1153 foreach (@{$columns}) 1154 { 1155 return 1 if !defined $self->{ColumnValues}[$_->{Number} - 1]; 1156 } 1157 return 0 1158} 1159###################################################################### 1160package XML::XMLtoDBMS::Column; 1161###################################################################### 1162#use strict; 1163sub new 1164{ 1165 my $type = shift; 1166 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1167 return bless $self, $type; 1168} 1169 1170###################################################################### 1171package XML::XMLtoDBMS::Order; 1172###################################################################### 1173#use strict; 1174use Carp; 1175 1176sub new 1177{ 1178 my $type = shift; 1179 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1180 return bless $self, $type; 1181} 1182 1183sub clear 1184{ 1185 my $self = shift; 1186 1187 $self->{FirstUnorderedChild} = undef; 1188 $self->{Start} = undef; 1189} 1190 1191sub insertChild 1192{ 1193 my ($self, $parent, $child, $orderValue, $level) = @_; 1194 #Insert a child in the correct position in its parent. This code 1195 #really ought to be rewritten to use a binary search. 1196 1197 #If the child is not ordered, then save it as the last child. If this 1198 #is the first unordered child, save it so we can place ordered 1199 #children before it. 1200 if (ref($parent) eq 'XML::LibXML::Document') 1201 { 1202 croak "more then one elements " . $child->getName . " in the root level" if defined $parent->documentElement; 1203 $parent->setDocumentElement($child); 1204 return; 1205 } 1206 if (defined $level) 1207 { 1208 if ($level ne "") 1209 { 1210 my @newNodes = $parent->findnodes($level); 1211 if ($#newNodes > -1) 1212 { 1213 $parent = $newNodes[0]; 1214 } 1215 else 1216 { 1217 my $newParent; 1218 $newParent = $parent->getOwnerDocument->createElement($level); 1219 $parent->appendChild($newParent); 1220 $parent = $newParent; 1221 } 1222 } 1223 } 1224 if ($orderValue == -1) 1225 { 1226 $parent->appendChild($child); 1227 1228 $self->{FirstUnorderedChild} = $child 1229 if !defined $self->{FirstUnorderedChild}; 1230 return; 1231 } 1232 1233 #Insert the child before the first node with a higher order value. 1234 #This is efficient if the children are added in reverse order 1235 #(highest order first), which is easy to do for children 1236 #corresponding to entire rows in class or columns in property tables 1237 #because we can sort the table on a single column. It is very 1238 #inefficient for children added in random order, such as those 1239 #corresponding to columns in a class table, which are accessed from 1240 #first column to last column. 1241 1242 my $current = $self->{Start}; 1243 my ($save, $newOrderNode); 1244 1245 while (defined $current) 1246 { 1247 if ($orderValue > $current->{OrderValue}) 1248 { 1249 $save = $current; 1250 $current = $current->{Next}; 1251 } 1252 else 1253 { 1254 #Insert the child and update the linked list of order info. 1255 $parent->insertBefore($child, $current->{Node}); 1256 1257 $newOrderNode = {OrderValue => $orderValue, 1258 Node => $child, 1259 Next => $current}; 1260 1261 if (!defined $save) 1262 { 1263 $self->{Start} = $newOrderNode; 1264 } 1265 else 1266 { 1267 $save->{Next} = {}; 1268 } 1269 return; 1270 } 1271 } 1272 1273 #If the order value is greater than the order values of all current 1274 #children, insert the child after the ordered children and before the 1275 #unordered children. 1276 1277 if (!defined $current) 1278 { 1279 $newOrderNode = {OrderValue => $orderValue, 1280 Node => $child, 1281 Next => $current}; 1282 1283 1284 print $child . $self->{FirstUnorderedChild} . "\n"; 1285 1286 $parent->insertBefore($child, $self->{FirstUnorderedChild}); 1287 1288 if (!defined $self->{Start}) 1289 { 1290 $self->{Start} = $newOrderNode; 1291 } 1292 else 1293 { 1294 $save->{Next} = $newOrderNode; 1295 } 1296 } 1297} 1298 1299###################################################################### 1300package XML::XMLtoDBMS::ColumnMap; 1301###################################################################### 1302#use strict; 1303sub new 1304{ 1305 my $type = shift; 1306 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1307 return bless $self, $type; 1308} 1309 1310###################################################################### 1311package XML::XMLtoDBMS::Table; 1312###################################################################### 1313#use strict; 1314use Carp; 1315 1316sub new 1317{ 1318 my $type = shift; 1319 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; #name is passed as argument 1320 return bless $self, $type; 1321} 1322 1323sub addColumn 1324{ 1325 my $self = shift; 1326 my $column = shift; 1327 1328 return if exists($self->{Columns}{$column}); 1329 1330 #print "added column $column to a table $self->{Name}\n" if defined $self->{Name}; 1331 $self->{Columns}{$column} = 0; #column only added 1332} 1333 1334sub addColumnWithCheck 1335{ 1336 my $self = shift; 1337 my $column = shift; 1338 1339 #print "adding column $column to a table $self->{Name}\n"; 1340 croak "More than one property mapped to the column $column in the table $self->{Name}" 1341 if (exists $self->{Columns}{$column} and $self->{Columns}{$column}); 1342 1343 $self->{Columns}{$column} = 1; #now column is mapped 1344} 1345###################################################################### 1346package XML::XMLtoDBMS::TableMap; 1347###################################################################### 1348#use strict; 1349use Carp; 1350 1351sub new 1352{ 1353 my $type = shift; 1354 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1355 return bless $self, $type; 1356} 1357 1358sub addElementTypeColumnMap 1359{ 1360 my $self = shift; 1361 my $column = shift; 1362 1363 croak "More than one property mapped to the $column->{Name} column in the $self->{Table}{Name} table." 1364 if (exists( $self->{ElementTypeColumnMaps}{$column}) or 1365 exists($self->{PropertyColumnMaps}{$column})); 1366 1367 my $columnMap = new XML::XMLtoDBMS::ColumnMap(Column => $column); 1368 return $self->{ElementTypeColumnMaps}{$column} = $columnMap; 1369} 1370 1371sub addPropertyColumnMap 1372{ 1373 my $self = shift; 1374 my $column = shift; 1375 1376 croak "More than one property mapped to the $column->{Name} column in the $self->{Table}{Name} table." 1377 if (exists( $self->{ElementTypeColumnMaps}{$column}) or 1378 exists($self->{PropertyColumnMaps}{$column})); 1379 1380 my $columnMap = new XML::XMLtoDBMS::ColumnMap(Column => $column); 1381 return $self->{PropertyColumnMaps}{$column} = $columnMap; 1382} 1383 1384 1385###################################################################### 1386package XML::XMLtoDBMS::ClassMap; 1387###################################################################### 1388#use strict; 1389use Carp; 1390sub new 1391{ 1392 my $type = shift; 1393 my $name = shift; 1394 my $self = { Name => $name, 1395 Type => 0, 1396 Table => undef, 1397 AttributeMaps => {}, 1398 SubElementTypeMaps => {}, 1399 PropMap => undef }; 1400 return bless $self, $type; 1401} 1402 1403sub addElementPropertyMap 1404{ 1405 my $self = shift; 1406 my $propMap = shift; 1407 my $name = $propMap->{Name}; 1408 1409 croak "Element type $name is mapped more then once as a related class or property of $self->{Name}" 1410 if exists($self->{SubElementTypeMaps}{$name}); 1411 #print "Added property map (element) $propMap->{Name} for class map $self->{Name}\n"; 1412 $self->{SubElementTypeMaps}{$name} = $propMap; 1413} 1414 1415sub addAttributePropertyMap 1416{ 1417 my $self = shift; 1418 my $propMap = shift; 1419 my $name = $propMap->{Name}; 1420 1421 croak "Element type $name is mapped more then once as a property of $self->{Name}" 1422 if exists($self->{AttributeMaps}{$name}); 1423 1424 #print "Added property map (attribute) $propMap->{Name} for class map $self->{Name}\n"; 1425 $self->{AttributeMaps}{$name} = $propMap; 1426} 1427 1428sub addRelatedClassMap 1429{ 1430 my $self = shift; 1431 my $relatedMap = shift; 1432 my $name = $relatedMap->{ClassMap}{Name}; 1433 1434 croak "Element type $name mapped more than once as a related class or property of $self->{Name}\n" 1435 if exists($self->{SubElementTypeMaps}{$name}); 1436 1437 #print "Added related map $name for class map $self->{Name}\n"; 1438 $self->{SubElementTypeMaps}{$name} = $relatedMap; 1439} 1440 1441 1442###################################################################### 1443package XML::XMLtoDBMS::RootTableMap; 1444###################################################################### 1445 1446use Carp; 1447#use strict; 1448 1449sub new 1450{ 1451 my $type = shift; 1452 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1453 return bless $self, $type; 1454} 1455 1456 1457###################################################################### 1458package XML::XMLtoDBMS::RootClassMap; 1459###################################################################### 1460 1461use Carp; 1462#use strict; 1463 1464sub new 1465{ 1466 my $type = shift; 1467 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1468 return bless $self, $type; 1469} 1470 1471 1472###################################################################### 1473package XML::XMLtoDBMS::RelatedClassMap; 1474###################################################################### 1475 1476#use strict; 1477 1478sub new 1479{ 1480 my $type = shift; 1481 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1482 1483 #my $self = {ClassMap => undef, OrderInfo => [], LinkInfo => { ParentKey => [], ChildKey => [], GenerateKey => 0, ParentKeyIsCandidate => 0}}; 1484 return bless $self, $type; 1485} 1486 1487###################################################################### 1488package XML::XMLtoDBMS::PropertyMap; 1489###################################################################### 1490 1491#use strict; 1492 1493sub new 1494{ 1495 my $type = shift; 1496 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1497 return bless $self, $type; 1498} 1499 1500 1501###################################################################### 1502package XML::XMLtoDBMS::Map; 1503###################################################################### 1504use Carp; 1505 1506use vars qw(%ColumnMapTypes %PropertyMapTypes %ClassMapTypes %TableMapTypes); 1507#use strict; 1508 1509BEGIN 1510{ 1511%ColumnMapTypes = (ToAttribute => 1, ToElementType => 2, ToPCData => 3); 1512%PropertyMapTypes = (ToColumn => 1, ToPropertyTable => 2); 1513%ClassMapTypes = (ToRootTable => 1, 1514 ToClassTable => 2, 1515 IgnoreRoot => 3, 1516 PassThrough => 4); 1517%TableMapTypes = (ClassTable => 1, PropertyTable => 2); 1518} 1519 1520sub new 1521{ 1522 my $type = shift; 1523 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 1524 $self = { PropertyTables => {}, 1525 ClassTablesByElemType => {}, 1526 ClassTablesByNames => {}, 1527 ClassMaps => {}, 1528 RootClassMaps => {}, 1529 MappedClasses => {}, 1530 TableMaps => {}, 1531 RootTableMaps => {}, 1532 MappedTables => {}, 1533 GenerateKeys => 0, 1534 EmptyStringIsNull => 0 }; 1535 return bless $self, $type; 1536} 1537 1538sub destroy 1539{ 1540 my $self = shift; 1541 my $stmt; 1542 1543 if (defined $self->{InsertStacks}) 1544 { 1545 foreach (@{$self->{InsertStacks}}) 1546 { 1547 foreach $stmt (@{$_}) 1548 { 1549 undef $stmt; 1550 } 1551 } 1552 undef $self->{InsertStacks}; 1553 } 1554 if (defined $self->{SelectStacks}) 1555 { 1556 foreach (@{$self->{SelectStacks}}) 1557 { 1558 foreach (@{$_}) 1559 { 1560 foreach (@{$_}) 1561 { 1562 undef $_; 1563 } 1564 } 1565 } 1566 undef $self->{SelectStacks}; 1567 } 1568} 1569 1570 1571 1572sub addClassMap 1573{ 1574 my $self = shift; 1575 my $name = shift; 1576 croak "Class $name is already mapped" 1577 if exists($self->{MappedClasses}{$name}); 1578 $self->{MappedClasses}{$name} = 1; 1579 return $self->getClassMap($name); 1580} 1581 1582sub getClassMap 1583{ 1584 my $self = shift; 1585 my $name = shift; 1586 return $self->{ClassMaps}{$name} 1587 if exists ($self->{ClassMaps}{$name}); 1588 #print "Added new classMap for $name\n"; 1589 return $self->{ClassMaps}{$name} = new XML::XMLtoDBMS::ClassMap($name); 1590} 1591 1592sub getNewClassMap 1593{ 1594 my $self = shift; 1595 my $name = shift; 1596 return $self->{NewClassMaps}{$name} 1597 if exists ($self->{NewClassMaps}{$name}); 1598 #print "Added new classMap for $name\n"; 1599 return $self->{NewClassMaps}{$name} = new XML::XMLtoDBMS::ClassMap($name); 1600} 1601 1602sub addClassTable 1603{ 1604 my $self = shift; 1605 my $classMapName = shift; 1606 my $tableName = shift; 1607 1608 croak "More than one class mapped to the table: $tableName" 1609 if exists($self->{ClassTablesByName}{$tableName}); 1610 croak "The table $tableName is used as both a property table and a class table." 1611 if exists($self->{PropertyTables}{$tableName}); 1612 1613 my $table = $self->{ClassTablesByElementType}{$classMapName}; 1614 if (defined $table) 1615 { 1616 $table->{Name} = $tableName; 1617 } 1618 else 1619 { 1620 $table = new XML::XMLtoDBMS::Table(Name => $tableName); 1621 $self->{ClassTablesByElementType}{classMapName} = $table; 1622 } 1623 $self->{ClassTablesByName}{$tableName} = $table; 1624 return $table; 1625} 1626 1627sub getClassTable 1628{ 1629 my $self = shift; 1630 my $elemTypeName = shift; 1631 1632 my $table = $self->{ClassTablesByElementType}{$elemTypeName}; 1633 1634 if (!defined $table) 1635 { 1636 $table = new XML::XMLtoDBMS::Table; #we do not know table name yet 1637 $self->{ClassTablesByElementType}{$elemTypeName} = $table; 1638 } 1639 return $table; 1640} 1641 1642sub addRootClassMap 1643{ 1644 my $self = shift; 1645 my $classMap = shift; 1646 my $name = $classMap->{Name}; 1647 1648 my $rootClassMap = new XML::XMLtoDBMS::RootClassMap(ClassMap => $classMap); 1649 1650 $self->{RootClassMaps}{$name} = $rootClassMap; 1651 return $rootClassMap; 1652} 1653 1654sub getRootTableMap 1655{ 1656 my $self = shift; 1657 my $rootTable = shift; 1658 1659 croak "Table not mapped as a root table: $rootTable" 1660 if (!defined $self->{RootTableMaps}{$rootTable}); 1661 return $self->{RootTableMaps}{$rootTable}; 1662} 1663 1664sub createTableMapsFromClassMaps 1665{ 1666 my $self = shift; 1667 1668 $self->checkRelatedClasses; 1669 $self->processClassMaps; 1670 $self->processRootClassMaps; 1671 #print "Ended somehow\n"; 1672} 1673 1674sub checkRelatedClasses 1675{ 1676 my $self = shift; 1677 #print "Checking related classes\n"; 1678 foreach my $className (keys %{$self->{ClassMaps}}) 1679 { 1680 #print "checking if $className class is mapped..."; 1681 croak "Element type $className was listed as a related class but was never mapped." 1682 if (!exists( $self->{MappedClasses}{$className})); 1683 #print "Yes\n"; 1684 } 1685} 1686 1687sub processClassMaps 1688{ 1689 my $self = shift; 1690 foreach my $className (keys %{$self->{ClassMaps}}) 1691 { 1692 my $classMap = $self->{ClassMaps}{$className}; 1693 #print "Processing class map for class $className with type $classMap->{Type}...\n"; 1694 1695 next if ($classMap->{Type} == $ClassMapTypes{IgnoreRoot} or $classMap->{Type} == $ClassMapTypes{PassThrough}); 1696 1697 my $tableMap = $self->addClassTableMap($classMap); 1698 1699 #print "processing Attributes...\n"; 1700 $self->processSubMaps($classMap->{AttributeMaps}, $tableMap, $ColumnMapTypes{ToAttribute}); 1701 1702 #print "processing SubElementTypes...\n"; 1703 $self->processSubMaps($classMap->{SubElementTypeMaps}, $tableMap, $ColumnMapTypes{ToElementType}); 1704 1705 $self->processPropertyMap($classMap->{PCDataMap}, $tableMap, $ColumnMapTypes{ToPCData}) 1706 if defined $classMap->{PCDataMap}; 1707 } 1708} 1709 1710sub processSubMaps 1711{ 1712 my $self = shift; 1713 my $subMap = shift; 1714 my $classTableMap = shift; 1715 my $columnType = shift; 1716 1717 foreach my $name (keys %{$subMap}) 1718 { 1719 my $Map = $subMap->{$name}; 1720 my $type = ref($Map); 1721 1722 if ($type eq 'XML::XMLtoDBMS::PropertyMap') 1723 { 1724 $self->processPropertyMap($Map, $classTableMap, $columnType); 1725 } 1726 elsif ($type eq 'XML::XMLtoDBMS::RelatedClassMap') 1727 { 1728 $self->processRelatedClassMap($Map, $classTableMap, $columnType); 1729 } 1730 else 1731 { 1732 croak "Map $name is of wrong type $type"; 1733 } 1734 } 1735} 1736 1737sub processPropertyMap 1738{ 1739 my $self = shift; 1740 my $propMap = shift; 1741 my $classTableMap = shift; 1742 my $columnType = shift; 1743 1744 1745 if ($propMap->{Type} eq $PropertyMapTypes{ToColumn}) 1746 { 1747 $self->createPropColumnMap($classTableMap, $propMap, $columnType); 1748 } 1749 elsif ($propMap->{Type} eq $PropertyMapTypes{ToPropertyTable}) 1750 { 1751 my $propTableRef = $self->createPropTableMap($classTableMap, $propMap); 1752 $self->createPropColumnMap($propTableRef, $propMap, $columnType); 1753 } 1754 else 1755 { 1756 croak "Unknown Property map type: $propMap->{Type}"; 1757 } 1758} 1759 1760sub processRelatedClassMap 1761{ 1762 my $self = shift; 1763 my $relatedMap = shift; 1764 my $classTableMap = shift; 1765 1766 my $type = $relatedMap->{ClassMap}{Type}; 1767 1768 if ($type = $ClassMapTypes{ToClassTable} or 1769 $type = $ClassMapTypes{ToRootTable}) 1770 { 1771 my $relatedTableMap = $self->getTableMap($relatedMap->{ClassMap}{Table}); 1772 push @{$classTableMap->{RelatedTables}}, $relatedTableMap; 1773 push @{$classTableMap->{ParentKeyIsCandidate}}, $relatedMap->{LinkInfo}{ParentKeyIsCandidate}; 1774 push @{$classTableMap->{ParentKeys}}, $relatedMap->{LinkInfo}{ParentKey}; 1775 push @{$classTableMap->{ChildKeys}}, $relatedMap->{LinkInfo}{ChildKey}; 1776 push @{$classTableMap->{OrderColumns}}, $relatedMap->{OrderInfo}{OrderColumn}; 1777 push @{$classTableMap->{Filter}}, $relatedMap->{Filter}; 1778 } 1779 elsif ($type = $ClassMapTypes{IgnoreRoot}) 1780 { 1781 croak "The element type $relatedMap->{ClassMap}{Name} was mapped as an ignored root, but listed as a related class."; 1782 } 1783 elsif ($type = $ClassMapTypes{Passthrough}) 1784 { 1785 croak "Class mapped as pass-through: $relatedMap->{ClassMap}{Name}"; 1786 } 1787} 1788 1789sub processRootClassMaps 1790{ 1791 my $self = shift; 1792 1793 foreach my $name (keys %{$self->{RootClassMaps}}) 1794 { 1795 my $rootClassMap = $self->{RootClassMaps}{$name}; 1796 #print "Processing root class map $name with type $rootClassMap->{ClassMap}{Type}\n"; 1797 1798 if ($rootClassMap->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}) 1799 { 1800 $self->processRootTableClassMap($rootClassMap); 1801 } 1802 elsif ($rootClassMap->{ClassMap}{Type} == $ClassMapTypes{IgnoreRoot}) 1803 { 1804 $self->processIgnoreRootClassMap($rootClassMap); 1805 } 1806 else 1807 { 1808 croak "Root classes must be mapped to root tables or ignored: $rootClassMap->{ClassMap}{Name}"; 1809 } 1810 } 1811} 1812 1813sub processRootTableClassMap 1814{ 1815 my $self = shift; 1816 my $rootClassMap = shift; 1817 1818 my $tableMap = $self->{TableMaps}{$rootClassMap->{ClassMap}{Table}}; 1819 1820 croak "Surprise! Root element map points to non-existent table: $rootClassMap->{ClassMap}{Name}" 1821 if (!defined $tableMap); 1822 1823 my $rootTableMap = $self->addRootTableMap($rootClassMap->{ClassMap}{Table}); 1824 1825 $rootTableMap->{TableMap} = $tableMap; 1826 1827 #print "Table map type $tableMap->{Type} mapped to the table $rootClassMap->{ClassMap}{Table}{Name}\n"; 1828 1829 croak "Root table must be mapped as $TableMapTypes{ClassTable}" 1830 if ($tableMap->{Type} != $TableMapTypes{ClassTable}); 1831 1832 $rootTableMap->{CandidateKey} = $rootClassMap->{LinkInfo}{ChildKey} 1833 if (defined $rootClassMap->{LinkInfo}); 1834 1835 $rootTableMap->{OrderColumn} = $rootClassMap->{OrderInfo}{OrderColumn}; 1836 1837 $rootTableMap->{Filter} = $rootClassMap->{Filter}; 1838} 1839 1840sub processIgnoreRootClassMap 1841{ 1842 my $self = shift; 1843 my $rootClassMap= shift; 1844 1845 my $subElementTypeMaps = $rootClassMap->{ClassMap}{SubElementTypeMaps}; 1846 1847 foreach my $name (keys %{$subElementTypeMaps}) 1848 { 1849 my $tempMap = $subElementTypeMaps->{$name}; 1850 if (ref($tempMap) eq "XML::XMLtoDBMS::RelatedClassMap") 1851 { 1852 my $relatedMap = $tempMap; 1853 my $rootTableMap = $self->addRootTableMap($relatedMap->{ClassMap}{Table}); 1854 1855 $rootTableMap->{TableMap} = $self->{TableMaps}{$relatedMap->{ClassMap}{Table}}; 1856 1857 #print "Table map $name of type $rootTableMap->{TableMap}{Type}\n"; 1858 1859 croak "Root table must be mapped as $TableMapTypes{ClassTable}" 1860 if ($rootTableMap->{TableMap}{Type} != $TableMapTypes{ClassTable}); 1861 1862 $rootTableMap->{CandidateKey} = $relatedMap->{LinkInfo}{ChildKey} 1863 if (defined $relatedMap->{LinkInfo}); 1864 1865 $rootTableMap->{OrderColumn} = $relatedMap->{OrderInfo}{OrderColumn}; 1866 $rootTableMap->{IgnoredRootType} = $rootClassMap->{ClassMap}{Name}; 1867 #$rootTableMap->{prefixedIgnoredRootType} = $rootClassMap->{ClassMap}{Name}; 1868 $rootTableMap->{Filter} = $relatedMap->{Filter}; 1869 } 1870 else 1871 { 1872 croak "The ignored root element type $rootClassMap->{ClassMap}{Name} has a child element type that is mapped as a property."; 1873 } 1874 } 1875} 1876 1877sub addRootTableMap 1878{ 1879 my $self = shift; 1880 my $table = shift; 1881 1882 croak "Table mapped as a root table more than once: $table->{Name}" 1883 if (exists ($self->{RootTableMaps}{$table})); 1884 1885 my $rootTableMap = new XML::XMLtoDBMS::RootTableMap; 1886 $self->{RootTableMaps}{$table} = $rootTableMap; 1887 1888 return $rootTableMap; 1889} 1890 1891sub addClassTableMap 1892{ 1893 my $self = shift; 1894 my $classMap = shift; 1895 1896 my $tableMap = $self->addTableMap($classMap->{Table}); 1897 $tableMap->{Type} = $TableMapTypes{ClassTable}; 1898 $tableMap->{ElementType} = $classMap->{Name}; 1899 $tableMap->{Level} = $classMap->{Level}; 1900 #$tableMap->{PrefixedElementType} = $classMap->{Name}; 1901 1902 return $tableMap; 1903} 1904 1905sub addPropertyTable 1906{ 1907 1908 my $self = shift; 1909 my $tableName = shift; 1910 1911 croak "The table $tableName is used as both a property table and a class table." 1912 if exists($self->{ClassTablesByName}{$tableName}); 1913 1914 croak "More than one property is mapped to the table $tableName" 1915 if exists($self->{PropertyTables}{$tableName}); 1916 1917 my $table = new XML::XMLtoDBMS::Table( Name => $tableName); 1918 $self->{PropertyTables}{$tableName} = $table; 1919 1920 return $table; 1921} 1922 1923sub addPropertyTableMap 1924{ 1925 my $self = shift; 1926 my $propMap = shift; 1927 1928 my $tableMap = $self->addTableMap($propMap->{Table}); 1929 $tableMap->{Type} = $TableMapTypes{PropertyTable}; 1930 1931 return $tableMap; 1932} 1933 1934sub addTableMap 1935{ 1936 my $self = shift; 1937 my $table = shift; 1938 1939 croak "More than one class or property mapped to the table $table->{Name}" 1940 if exists($self->{MappedTables}{$table}); 1941 1942 $self->{MappedTables}{$table} = 1; 1943 1944 return $self->getTableMap($table); 1945} 1946 1947sub getTableMap 1948{ 1949 my $self = shift; 1950 my $table = shift; 1951 1952 my $tableMap = $self->{TableMaps}{$table}; 1953 1954 if (!defined $tableMap) 1955 { 1956 $tableMap = new XML::XMLtoDBMS::TableMap(Table => $table); 1957 $self->{TableMaps}{$table} = $tableMap; 1958 } 1959 return $tableMap; 1960} 1961 1962sub createPropTableMap 1963{ 1964 my $self = shift; 1965 my $parentTableMap = shift; 1966 my $propMap = shift; 1967 1968 my $propTableMap = $self->addPropertyTableMap($propMap); 1969 1970 push @{$parentTableMap->{RelatedTables}}, $propTableMap; 1971 $parentTableMap->{ParentKeyIsCandidate} = $propMap->{LinkInfo}{ParentKeyIsCandidate}; 1972 push @{$parentTableMap->{ParentKeys}}, $propMap->{LinkInfo}{ParentKey}; 1973 push @{$parentTableMap->{ChildKeys}}, $propMap->{LinkInfo}{ChildKey}; 1974 push @{$parentTableMap->{OrderColumns}}, $propMap->{OrderInfo}{OrderColumn}; #now reference to an array 1975 push @{$parentTableMap->{Filter}}, $propMap->{Filter}; 1976 1977 return $propTableMap; 1978 } 1979 1980 1981sub createPropColumnMap 1982{ 1983 my $self = shift; 1984 my $tableMap = shift; 1985 my $propMap = shift; 1986 my $columnType = shift; 1987 1988 my $columnMap; 1989 1990 if ($columnType == $ColumnMapTypes{ToElementType}) 1991 { 1992 $columnMap = $tableMap->addElementTypeColumnMap($propMap->{Column}); 1993 } 1994 else 1995 { 1996 $columnMap = $tableMap->addPropertyColumnMap($propMap->{Column}); 1997 } 1998 $columnMap->{Type} = $columnType; 1999 $columnMap->{Property} = $propMap->{Name}; 2000 $columnMap->{MultiValued} = $propMap->{MultiValued}; 2001 $columnMap->{OrderColumn} = $propMap->{OrderInfo}{OrderColumn}; 2002} 2003 2004sub createMapFromTemp 2005{ 2006 my $self = shift; 2007 $self->convertMap; 2008 return $self; 2009} 2010 2011sub convertMap 2012{ 2013 my $self = shift; 2014 $self->convertTables; 2015 $self->convertTableMaps; 2016 $self->convertClassMaps; 2017} 2018 2019sub convertTables 2020{ 2021 2022 my $self = shift; 2023 $self->{Tables} = []; 2024 2025 #print "Converting tables...\n"; 2026 foreach (keys %{$self->{ClassTablesByName}}) 2027 { 2028 #push @{$self->{Tables}}, $self->{ClassTablesByName}{$_}; 2029 $self->convertTable($self->{ClassTablesByName}{$_}) 2030 } 2031 delete $self->{ClassTablesByName}; 2032 foreach (keys %{$self->{PropertyTables}}) 2033 { 2034 #push @{$self->{Tables}}, $self->{PropertyTables}{$_}; 2035 $self->convertTable($self->{PropertyTables}{$_}) 2036 } 2037 delete $self->{PropertyTables}; 2038} 2039 2040sub convertTable 2041{ 2042 my $self = shift; 2043 my $table = shift; 2044 2045 my @columns; 2046 my $ind = 1; 2047 2048 foreach (keys %{$table->{Columns}}) 2049 { 2050 push @columns, new XML::XMLtoDBMS::Column(Name => $_, Number => $ind++); 2051 } 2052 delete $table->{Columns}; 2053 push @{$self->{Tables}}, new XML::XMLtoDBMS::Table(Name => $table->{Name}, 2054 Number => $#{$self->{Tables}} + 1, 2055 Columns => \@columns); 2056} 2057 2058sub convertTableMaps 2059{ 2060 my $self = shift; 2061 $self->buildTableInfos; 2062 $self->convertTableMaps1; 2063 #$self->convertTableMaps2; 2064 $self->convertRootTableMaps; 2065} 2066 2067sub convertClassMaps 2068{ 2069 my $self = shift; 2070 2071 foreach (keys %{$self->{ClassMaps}}) 2072 { 2073 $self->convertClassMap($self->{ClassMaps}{$_}); 2074 } 2075 $self->convertRootClassMaps; 2076 $self->{ClassMaps} = $self->{NewClassMaps}; 2077} 2078 2079sub convertClassMap 2080{ 2081 my $self = shift; 2082 my $tempClassMap = shift; 2083 2084 my $classMap = $self->getNewClassMap($tempClassMap->{Name}); 2085 2086 $classMap->{Name} = $tempClassMap->{Name}; 2087 $classMap->{Type} = $tempClassMap->{Type}; 2088 $classMap->{Level} = $tempClassMap->{Level}; 2089 #print "Converting Map $tempClassMap->{Name}\n"; 2090 if ($tempClassMap->{Type} != $ClassMapTypes{IgnoreRoot}) 2091 { 2092 my $tableInfo = $self->{TableInfos}{$tempClassMap->{Table}{Name}}; 2093 $classMap->{Table} = $tableInfo->{Table}; 2094 $self->convertSubMaps( $classMap->{AttributeMaps}, 2095 $tempClassMap->{AttributeMaps}, 2096 $tableInfo ); 2097 2098 $classMap->{PCDataMap} = $self->convertPropertyMap($tempClassMap->{PCDataMap}, $tableInfo) 2099 if defined $tempClassMap->{PCDataMap}; 2100 2101 $self->convertSubMaps( $classMap->{SubElementTypeMaps}, 2102 $tempClassMap->{SubElementTypeMaps}, 2103 $tableInfo ); 2104 2105 } 2106 else 2107 { 2108 $self->convertSubMaps( $classMap->{SubElementTypeMaps}, 2109 $tempClassMap->{SubElementTypeMaps}, 2110 undef ); 2111 } 2112 $tempClassMap = $classMap; 2113} 2114 2115sub convertSubMaps 2116{ 2117 my ($self, $dest, $src, $parentTableInfo) = @_; 2118 2119 #This method converts hashtables containing maps subordinate to the 2120 #class map. These hashtables can contain either property maps only 2121 #the hashtable maps for attributes) or a mixture of property maps and 2122 #related class maps (the hashtable for subelement types). 2123 2124 foreach (keys %{$src}) 2125 { 2126 my $tempMap = $src->{$_}; 2127 2128 2129 if (ref($tempMap) eq 'XML::XMLtoDBMS::PropertyMap') 2130 { 2131 #print "Converting Property $tempMap->{Name}\n"; 2132 my $tempPropMap = $tempMap; 2133 my $propMap = $self->convertPropertyMap($tempPropMap, $parentTableInfo); 2134 $dest->{$tempPropMap->{Name}} = $propMap; 2135 } 2136 elsif (ref($tempMap) eq 'XML::XMLtoDBMS::RelatedClassMap') 2137 { 2138 #print "Converting RelatedClass $tempMap->{ClassMap}{Name}\n"; 2139 my $tempRelatedClassMap = $tempMap; 2140 my $relatedClassMap = $self->convertRelatedClassMap($tempRelatedClassMap, $parentTableInfo); 2141 $dest->{$tempRelatedClassMap->{ClassMap}{Name}} = $relatedClassMap; 2142 } 2143 else 2144 { 2145 croak "Unknown type of map: should be PropertyMap or RelatedClassMap)"; 2146 } 2147 } 2148} 2149 2150sub convertPropertyMap 2151{ 2152 my ($self, $tempPropMap, $parentTableInfo) = @_; 2153 2154 my $propMap = new XML::XMLtoDBMS::PropertyMap(Type => $tempPropMap->{Type}, 2155 MultiValued =>$tempPropMap->{MultiValued}); 2156 $propMap->{Name} = $tempPropMap->{Name} 2157 if (defined $tempPropMap->{Name}); 2158 2159 if (defined $tempPropMap->{Table}) 2160 { 2161 #If the property is mapped to a table, get the TableInfo for that 2162 #table and set the table, column, link, and order information. Note 2163 #that the column occurs in the property table, not the parent table 2164 #and that the order column occurs in the table with the child key. 2165 2166 my $propTableInfo = $self->{TableInfos}{$tempPropMap->{Name}}; 2167 $propMap->{Table} = $propTableInfo->{Table}; 2168 $propMap->{Column} = $propTableInfo->{Columns}{$tempPropMap->{Name}}; 2169 $propMap->{LinkInfo} = $self->convertLinkInfo($tempPropMap->{LinkInfo}, 2170 $parentTableInfo, $propTableInfo); 2171 if ($propMap->{LinkInfo}{ParentKeyIsCandidate}) 2172 { 2173 $propMap->{OrderInfo} = $self->convertOrderInfo($tempPropMap->{OrderInfo}, 2174 $propTableInfo); 2175 } 2176 else 2177 { 2178 $propMap->{OrderInfo} = $self->convertOrderInfo($tempPropMap->{OrderInfo}, 2179 $parentTableInfo); 2180 } 2181 } 2182 else 2183 { 2184 #If the property is mapped to a column, set the column and order 2185 #information. Note that these occur in the parent table. 2186 2187 $propMap->{Column} = $parentTableInfo->{Columns}{$tempPropMap->{Column}}; 2188 $propMap->{OrderInfo} = $self->convertOrderInfo($tempPropMap->{OrderInfo}, $parentTableInfo); 2189 } 2190 return $propMap; 2191} 2192 2193sub convertRelatedClassMap 2194{ 2195 my ($self, $tempRelatedMap, $parentTableInfo) = @_; 2196 2197 #Create a new RelatedClassMap and set the ClassMap. Note that 2198 #getClassMap() might create the map. 2199 2200 my $orderInfo; 2201 my $classMap = $self->getNewClassMap($tempRelatedMap->{ClassMap}{Name}); 2202 2203 my $relatedInfo = $self->{TableInfos}{$tempRelatedMap->{ClassMap}{Table}{Name}}; 2204 my $linkInfo = $self->convertLinkInfo($tempRelatedMap->{LinkInfo}, $parentTableInfo, $relatedInfo); 2205 2206 if ($tempRelatedMap->{LinkInfo}{ParentKeyIsCandidate}) 2207 { 2208 $orderInfo = $self->convertOrderInfo($tempRelatedMap->{OrderInfo}, $relatedInfo); 2209 } 2210 else 2211 { 2212 $orderInfo = $self->convertOrderInfo($tempRelatedMap->{OrderInfo}, $parentTableInfo); 2213 } 2214 return new XML::XMLtoDBMS::RelatedClassMap(ClassMap => $classMap, 2215 LinkInfo => $linkInfo, 2216 OrderInfo => $orderInfo, 2217 Filter => $tempRelatedMap->{Filter}); 2218} 2219 2220sub convertLinkInfo 2221{ 2222 my ($self, $tempLinkInfo, $parentInfo, $childInfo) = @_; 2223 2224 my ($parentKey, $childKey) = ([], []); 2225 2226 $self->convertKeyColumns($parentKey, $tempLinkInfo->{ParentKey}, $parentInfo->{Columns}) 2227 if exists($tempLinkInfo->{ParentKey}); 2228 $self->convertKeyColumns($childKey, $tempLinkInfo->{ChildKey}, $childInfo->{Columns}); 2229 2230 return {GenerateKey => $tempLinkInfo->{GenerateKey}, 2231 ParentKeyIsCandidate => $tempLinkInfo->{ParentKeyIsCandidate}, 2232 ParentKey => $parentKey, 2233 ChildKey => $childKey}; 2234} 2235 2236sub convertOrderInfo 2237{ 2238 my ($self, $tempOrderInfo, $tableInfo); 2239 2240 return undef if !defined $tempOrderInfo; 2241 2242 return { 2243 GenerateOrder => $tempOrderInfo->{GenerateOrder}, 2244 OrderColumn => (defined $tempOrderInfo->{OrderColumn}) ? $tableInfo->{Columns}{$tempOrderInfo->{OrderColumn}} : undef, 2245 Direction => $tempOrderInfo->{Direction} 2246 }; 2247} 2248 2249sub convertRootClassMaps 2250{ 2251 my $self = shift; 2252 2253 foreach (keys %{$self->{RootClassMaps}}) 2254 { 2255 my $tempRootClassMap = $self->{RootClassMaps}{$_}; 2256 my $rootClassMap = $self->convertRootClassMap($tempRootClassMap); 2257 2258 #now lets delete the old RootClassMap reference even though 2259 #it might have the same key=$name since we use the same RootClassMaps array 2260 2261 my $name = $tempRootClassMap->{ClassMap}{Name}; 2262 delete $self->{RootClassMaps}{$_}; 2263 $self->{RootClassMaps}{$name} = $rootClassMap; 2264 } 2265} 2266 2267sub convertRootClassMap 2268{ 2269 my $self = shift; 2270 my $tempRootMap = shift; 2271 2272 my $rootMap = new XML::XMLtoDBMS::RootClassMap; 2273 $rootMap->{ClassMap} = $self->getNewClassMap($tempRootMap->{ClassMap}{Name}); 2274 2275 #Convert the link info and order info. Note that link info can only 2276 #be null in the case where the root element type is mapped as 2277 #IGNOREROOT. In this case, the order info is always null. 2278 2279 if (defined $tempRootMap->{LinkInfo}) 2280 { 2281 #Get the TableInfo for the related class' table. 2282 my $rootInfo = $self->{TableInfos}{$tempRootMap->{ClassMap}{Table}{Name}}; 2283 2284 #Convert the link and order info. Note that the order column is 2285 #always in the "child" (root) table, regardless of the value of 2286 #parentKeyIsCandidate. This is because there is no parent table. 2287 2288 $rootMap->{LinkInfo} = $self->convertLinkInfo($tempRootMap->{LinkInfo}, undef, $rootInfo); 2289 $rootMap->{OrderInfo} = $self->convertOrderInfo($tempRootMap->{OrderInfo}, $rootInfo); 2290 } 2291 $rootMap->{Filter} = $tempRootMap->{Filter}; 2292 return $rootMap; 2293} 2294 2295sub buildTableInfos 2296{ 2297 my $self = shift; 2298 2299 #print "Building TableInfo structures...\n"; 2300 foreach (@{$self->{Tables}}) 2301 { 2302 #print "Table $_->{Name} has columns "; 2303 my $columns = {}; 2304 foreach (@{$_->{Columns}}) 2305 { 2306 $columns->{$_->{Name}} = $_; 2307 #print "$_->{Name} "; 2308 } 2309 #print "\n"; 2310 $self->{TableInfos}{$_->{Name}} = {Table => $_, Columns => $columns}; 2311 } 2312} 2313 2314sub convertTableMaps1 2315{ 2316 my $self = shift; 2317 2318 my @tableMaps; 2319 2320 foreach (keys %{$self->{TableMaps}}) 2321 { 2322 my $tableMap = $self->{TableMaps}{$_}; 2323 #print "Converting table for table $tableMap->{Table}{Name}\n"; 2324 my $tableInfo = $self->{TableInfos}{$tableMap->{Table}{Name}}; 2325 2326 my $columnMaps = []; 2327 2328 $self->processColumnMaps($tableMap->{ElementTypeColumnMaps}, 2329 $columnMaps, $tableInfo->{Columns}); 2330 2331 $self->processColumnMaps($tableMap->{PropertyColumnMaps}, 2332 $columnMaps, $tableInfo->{Columns}); 2333 2334 my $newTableMap = new XML::XMLtoDBMS::TableMap(Table => $tableInfo->{Table}, 2335 Type => $tableMap->{Type}, 2336 Level => $tableMap->{Level}, 2337 ElementType => $tableMap->{ElementType}, 2338 ColumnMaps => $columnMaps, 2339 RelatedTables => [], 2340 Filter => $tableMap->{Filter}); 2341 2342 $tableMaps[$tableInfo->{Table}{Number}] = $newTableMap; 2343 } 2344 ############ assign @tableMaps to {TableMaps} before exiting this function 2345 foreach (keys %{$self->{TableMaps}}) 2346 { 2347 my $tableMap = $self->{TableMaps}{$_}; 2348 2349 my $tableInfo = $self->{TableInfos}{$tableMap->{Table}{Name}}; 2350 my $newTableMap = $tableMaps[$tableInfo->{Table}{Number}]; 2351 2352 for (my $i = 0; $i < $#{$tableMap->{RelatedTables}} + 1; $i++) 2353 { 2354 my $relatedTable = $tableMap->{RelatedTables}[$i]; 2355 my $relatedInfo = $self->{TableInfos}{$relatedTable->{Table}{Name}}; 2356 2357 push @{$newTableMap->{RelatedTables}}, $tableMaps[$relatedInfo->{Table}{Number}]; 2358 push @{$newTableMap->{ParentKeyIsCandidate}}, $tableMap->{ParentKeyIsCandidate}[$i]; 2359 2360 #print "Table $tableMap->{Table}{Name} has related table $relatedTable->{Table}{Name}\n"; 2361 #print "$tableMap->{ParentKeyIsCandidate}[$i]\n"; 2362 2363 $newTableMap->{ParentKeys}[$i] = []; 2364 $newTableMap->{ChildKeys}[$i] = []; 2365 $self->convertKeyColumns($newTableMap->{ParentKeys}[$i], $tableMap->{ParentKeys}[$i], $tableInfo->{Columns}); 2366 $self->convertKeyColumns($newTableMap->{ChildKeys}[$i], $tableMap->{ChildKeys}[$i], $relatedInfo->{Columns}); 2367 2368 if (!defined $relatedTable->{OrderColumn}[$i]) 2369 { 2370 push @{$newTableMap->{OrderColumn}}, undef; 2371 } 2372 elsif ($relatedTable->{ParentKeyIsCandidate}[$i]) 2373 { 2374 push @{$newTableMap->{OrderColumn}}, $relatedInfo->{Columns}{$tableMap->{OrderColumn}[$i]}; ### smth to be done here 2375 } 2376 else 2377 { 2378 push @{$newTableMap->{OrderColumn}}, $tableInfo->{Columns}{$tableMap->{OrderColumn}[$i]}; 2379 } 2380 } 2381 } 2382 delete $self->{TableMaps}; 2383 $self->{TableMaps} = \@tableMaps; 2384} 2385 2386 2387sub convertKeyColumns 2388{ 2389 my ($self, $keyColumns, $tempColumns, $columns) = @_; 2390 2391 #print "Related columns are: "; 2392 foreach (@{$tempColumns}) 2393 { 2394 #print "$_ "; 2395 push @{$keyColumns}, $columns->{$_}; 2396 } 2397 #print "\n"; 2398} 2399 2400sub processColumnMaps 2401{ 2402 my $self = shift; 2403 my $columnMaps = shift; 2404 my $newColumnMaps = shift; 2405 my $columns = shift; 2406 2407 my $orderColumn; 2408 foreach (values %{$columnMaps}) 2409 { 2410 $orderColumn = (!defined $columnMaps->{OrderColumn})? undef : $columns->{$_->{OrderColumn}}; 2411 push @{$newColumnMaps}, 2412 new XML::XMLtoDBMS::ColumnMap( Type => $_->{Type}, 2413 Column => $columns->{$_->{Column}}, 2414 OrderColumn => $orderColumn, 2415 Property => $_->{Property}, 2416 MultiValued => $_->{MultiValued}); 2417 } 2418} 2419 2420sub convertRootTableMaps 2421{ 2422 my $self = shift; 2423 my $rootTableMaps = {}; 2424 my $candidateKey = []; 2425 2426 foreach (keys %{$self->{RootTableMaps}}) 2427 { 2428 my $rootTableMap = $self->{RootTableMaps}{$_}; 2429 #print "Creating rootmap that maps to table $rootTableMap->{TableMap}{Table}{Name}\n"; 2430 my $tableName = $rootTableMap->{TableMap}{Table}{Name}; 2431 my $tableInfo = $self->{TableInfos}{$tableName}; 2432 2433 $self->convertKeyColumns($candidateKey, $rootTableMap->{CandidateKey}, $tableInfo->{Columns}); 2434 2435 my $orderColumn; 2436 2437 $orderColumn = $tableInfo->{Columns}{$rootTableMap->{OrderColumn}} 2438 if defined $rootTableMap->{OrderColumn}; 2439 2440 $rootTableMaps->{$tableName} = new XML::XMLtoDBMS::RootTableMap( 2441 TableMap => $self->{TableMaps}[$tableInfo->{Table}{Number}], 2442 IgnoredRootType => $rootTableMap->{IgnoredRootType}, 2443 CandidateKey => $candidateKey, 2444 OrderColumn => $orderColumn, 2445 OrderDirection => $rootTableMap->{OrderDirection}, 2446 Filter => $rootTableMap->{Filter} ); 2447 2448 } 2449 delete $self->{RootTableMaps}; 2450 $self->{RootTableMaps} = $rootTableMaps; 2451} 2452 2453sub checkOutSelectStmt 2454{ 2455 my ($self, $table, $whereColumns, $orderbyColumn, $filter, $keysonly) = @_; 2456 my $stmt; 2457 2458 croak "Connection not set." if !defined $self->{DB}; 2459 2460 my $selectString = $self->buildSelectString($table, $whereColumns, $orderbyColumn, $filter, $keysonly); 2461 2462 $stmt = $self->{DB}->prepare($selectString); 2463 print "$selectString\n" if !defined $stmt; 2464 return $stmt; 2465} 2466 2467sub checkOutSelectStmtByTable 2468{ 2469 my ($self, $tableNum, $subTableNum) = @_; 2470 my $stmt; 2471 2472 croak "Connection not set." if !defined $self->{DB}; 2473 2474 #If the select strings have not yet been built, build them now. 2475 2476 $self->buildSelectStrings if !defined $self->{SelectStrings}; 2477 2478 return pop @{$self->{SelectStacks}[$tableNum][$subTableNum]} 2479 if scalar @{$self->{SelectStacks}[$tableNum][$subTableNum]}; 2480 2481 #Since no prepared statement is available, try to create a new one. If 2482 #this fails, assumes that the reason is a limit on the number of 2483 #prepared statements, close an existing (unused) statement, and try 2484 #again. If this fails, or if there are no unused statements to close, 2485 #throw an error. 2486 2487 $stmt = $self->{DB}->prepare($self->{SelectStrings}[$tableNum][$subTableNum]); 2488 print $self->{SelectStrings}[$tableNum][$subTableNum] . "\n" if (!defined $stmt); 2489 return $stmt; 2490} 2491 2492sub buildSelectStrings 2493{ 2494 my $self = shift; 2495 my $i = 0; 2496 2497 $self->{SelectStrings} = []; 2498 $self->{SelectStacks} = []; 2499 2500 foreach my $tableMap (@{$self->{TableMaps}}) 2501 { 2502 my $j = 0; 2503 foreach (@{$tableMap->{RelatedTables}}) 2504 { 2505 push @{$self->{SelectStrings}[$i]}, $self->buildSelectStringForRelatedTable($tableMap, $j++); 2506 push @{$self->{SelectStacks}[$i]}, []; 2507 } 2508 $i++; 2509 } 2510} 2511 2512sub buildSelectStringForRelatedTable 2513{ 2514 my $self = shift; 2515 my $tableMap = shift; 2516 my $relatedTable = shift; 2517 2518 croak "BUG! DBMS => XML data transfer not supported when: a) the candidate key in the relationship linking two element types is stored in the table of the child element type, and b) order information about the child element type is stored in the database." 2519 if (defined $tableMap->{OrderColumns}[$relatedTable] and 2520 !$tableMap->{ParentKeyIsCandidate}); 2521 2522 #BUG!!! The order column stuff doesn't work when the parent key is 2523 #a foreign key. In fact, the entire Row object falls apart. The 2524 #problem is that in this case, the order column is in the parent table, 2525 #which thus needs to be joined to the child table, which means that the 2526 #result set is no longer shaped like a single table -- the assumption 2527 #on which Row (and probably a lot of other code) is built. 2528 2529 return $self->buildSelectString($tableMap->{RelatedTables}[$relatedTable]{Table}, 2530 $tableMap->{ChildKeys}[$relatedTable], 2531 $tableMap->{OrderColumns}[$relatedTable], 2532 $tableMap->{Filter}[$relatedTable]); 2533} 2534 2535sub buildSelectString 2536{ 2537 my ($self, $table, $whereColumns, $orderbyColumn, $filter, $keysonly) = @_; 2538 2539 my $selectString = "SELECT "; 2540 my $comma = ''; 2541 my @columns; 2542 my $includeOrderColumn; 2543 2544 if (!defined $keysonly or $keysonly == 0) 2545 { 2546 @columns = @{$table->{Columns}}; 2547 } 2548 else 2549 { 2550 if (defined $orderbyColumn) 2551 { 2552 $includeOrderColumn = 1; 2553 foreach (@{$whereColumns}) 2554 { 2555 if ($orderbyColumn == $_) 2556 { 2557 $includeOrderColumn = 0; 2558 last; 2559 } 2560 } 2561 } 2562 else 2563 { 2564 $includeOrderColumn = 0; 2565 } 2566 2567 if ($includeOrderColumn) 2568 { 2569 @columns = (@{$whereColumns}, $orderbyColumn); 2570 } 2571 else 2572 { 2573 @columns = @{$whereColumns}; 2574 } 2575 undef $whereColumns; 2576 } 2577 2578 foreach(@columns) 2579 { 2580 $selectString .= $comma . $self->replaceParameters($_->{Name}); 2581 $comma = ', '; 2582 } 2583 2584 $selectString .= " FROM $table->{Name}"; 2585 2586 $filter = $self->replaceParameters($filter) if defined $filter; 2587 2588 if (defined $whereColumns) 2589 { 2590 if ($whereColumns > 0) 2591 { 2592 $selectString .= " WHERE "; 2593 my $and = ''; 2594 2595 foreach(@{$whereColumns}) 2596 { 2597 $selectString .= $and . $_->{Name} . " = ? "; 2598 #$selectString .= $and . "(" . $_->{Name} . " = ? "; 2599 #$selectString .= "OR (? IS NULL AND " . $_->{Name} . " IS NULL))"; 2600 $and = ' AND '; 2601 } 2602 2603 $selectString .= " AND " . $filter if defined $filter; 2604 } 2605 else 2606 { 2607 $selectString .= " WHERE " . $filter if defined $filter; 2608 } 2609 } 2610 else 2611 { 2612 $selectString .= " WHERE " . $filter if defined $filter; 2613 } 2614 2615 #Add ORDER BY clause. We sort in descending order because this 2616 #gives us better performance in some cases. For more details, 2617 #see DBMSToDOM.Order.insertChild, which really ought to be 2618 #rewritten to use a binary search. 2619 2620 if (defined $orderbyColumn) 2621 { 2622 $selectString .= " ORDER BY $orderbyColumn->{Name}"; 2623 } 2624 #print $selectString . "\n"; 2625 return $selectString; 2626} 2627 2628sub checkInSelectStmt 2629{ 2630 my ($self, $prepStmt, $tableNum, $subTableNum) = @_; 2631 2632 croak "Connection not set." if !defined $self->{DB}; 2633 2634 push @{$self->{SelectStacks}[$tableNum][$subTableNum]}, $prepStmt 2635 if (defined $tableNum); 2636} 2637 2638sub checkOutInsertStmt 2639{ 2640 my $self = shift; 2641 my $table = shift; 2642 2643 croak "Connection not set." if !defined $self->{DB}; 2644 2645 $self->buildInsertStrings if !defined $self->{InsertStrings}; 2646 2647 #checkMaxActiveStmts(); 2648 2649 if (defined $self->{InsertStacks}[$table->{Number}][0]) #if array has elements 2650 { 2651 return pop @{$self->{InsertStacks}[$table->{Number}]}; 2652 } 2653 #print $self->{InsertStrings}[$table->{Number}] . "\n"; 2654 return $self->{DB}->prepare($self->{InsertStrings}[$table->{Number}]); 2655} 2656 2657sub checkInInsertStmt 2658{ 2659 my $self = shift; 2660 my $preparedStmt = shift; 2661 my $table = shift; 2662 2663 croak "Connection not set." if !defined $self->{DB}; 2664 2665 push @{$self->{InsertStacks}[$table->{Number}]}, $preparedStmt; 2666} 2667 2668sub buildInsertStrings 2669{ 2670 my $self = shift; 2671 $self->{InsertStrings} = []; 2672 $self->{InsertStacks} = []; 2673 2674 foreach (@{$self->{Tables}}) 2675 { 2676 push @{$self->{InsertStrings}}, $self->buildInsertString($_); 2677 push @{$self->{InsertStacks}}, []; 2678 } 2679} 2680 2681sub buildInsertString 2682{ 2683 my $self = shift; 2684 my $table = shift; 2685 2686 my $istr = "INSERT INTO $table->{Name} ("; 2687 my $comma = ''; 2688 2689 foreach(@{$table->{Columns}}) 2690 { 2691 $istr .= "$comma$_->{Name}"; 2692 $comma = ', '; 2693 } 2694 $istr .= ") VALUES ("; 2695 2696 $comma = ''; 2697 foreach(@{$table->{Columns}}) 2698 { 2699 $istr .= "$comma?"; 2700 $comma = ', '; 2701 } 2702 $istr .= ")"; 2703 #print $istr . "\n"; 2704 return $istr; 2705} 2706 2707sub replaceParameters 2708{ 2709 my ($self, $string) = @_; 2710 2711 my ($key, $value); 2712 2713 while (($key, $value) = each(%{$self->{Parameters}})) 2714 { 2715 $value = "" if not defined $value; 2716 $string =~ s/\$${key}/${value}/g ; 2717 } 2718 return $string; 2719} 2720 2721###################################################################### 2722package XML::XMLtoDBMS::MapFactory; 2723###################################################################### 2724#use strict; 2725use Carp; 2726 2727use XML::Parser::PerlSAX; 2728use vars qw(%States %ClassMapTypes %PropertyMapTypes %ColumnMapTypes); 2729 2730 2731BEGIN 2732{ 2733 %States = (None => 0x00, ClassMap => 0x01, ToRootTable => 0x02, 2734 ToClassTable => 0x04, IgnoreRoot => 0x08, PropertyMap => 0x10, 2735 ToColumn => 0x20, ToPropertyTable => 0x40, CandidateKey => 0x80, 2736 ForeignKey => 0x100, RelatedClass => 0x200, PseudoRoot => 0x400, 2737 Root => 0x03, RootCandidate => 0x83, ClassTable => 0x05, 2738 Prop => 0x11, PropToColumn => 0x31, PropToTable => 0x51, 2739 PropCandidate => 0xD1, PropForeign => 0x151, Related => 0x201, 2740 RelatedCandidate => 0x281, RelatedForeign => 0x301, Pseudo => 0x408, 2741 PseudoCandidate => 0x488 ); 2742 2743 %ClassMapTypes = ( ToRootTable => 1, 2744 ToClassTable => 2, 2745 IgnoreRoot => 3, 2746 PassThrough => 4); 2747 2748 %PropertyMapTypes = (ToColumn => 1, ToPropertyTable => 2); 2749} 2750 2751sub new 2752{ 2753 my $type = shift; 2754 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; 2755 bless $self, $type; 2756 $self->initialize; 2757 return $self; 2758} 2759 2760sub initialize 2761{ 2762 my $self = shift; 2763 $self->{State} = $States{None}; 2764 $self->{Map} = new XML::XMLtoDBMS::Map; 2765} 2766 2767sub createMap 2768{ 2769 my $self = shift; 2770 my $file = shift; 2771 my $dbh = shift; 2772 my $parser = new XML::Parser::PerlSAX( Handler => $self ); 2773 $parser->parse(Source => {SystemId => $file}); 2774 #print "Parser finished\n"; 2775 $self->{Map}->{DB} = $dbh; 2776 $self->{Map}->createTableMapsFromClassMaps; 2777 return $self->{Map}->createMapFromTemp; 2778} 2779 2780sub start_document 2781{ 2782 my $self = shift; 2783 2784 $self->{lists} = []; 2785 $self->{cur_list} = []; 2786} 2787 2788sub end_document 2789{ 2790 my $self = shift; 2791 2792 $self->{Map}{Parameters}{DateFormat} = convertFormat($self->{DatePattern} ? $self->{DatePattern} : "YYYY-MM-DD"); 2793 $self->{Map}{Parameters}{TimeFormat} = convertFormat($self->{TimePattern} ? $self->{TimePattern} : "hh:mm:ss"); 2794 $self->{Map}{Parameters}{TimestampFormat} = convertFormat($self->{TimestampPattern} ? $self->{TimestampPattern} : "YYYY-MM-DDThh:mm:ssZ"); 2795 2796 delete $self->{cur_list}; 2797 delete $self->{lists}; 2798} 2799 2800sub start_element { 2801 my $self = shift; 2802 my $element = shift; 2803 my $contents = []; 2804 $element->{Contents} = $contents; 2805 my $sub = "$element->{Name}"; 2806 2807 &$sub($self, $element->{Attributes}); 2808 #print "StateIN is $self->{State}\n"; 2809 2810 push @{ $self->{lists} }, $self->{cur_list}; 2811 push @{ $self->{cur_list} }, $element; 2812 $self->{cur_list} = $contents; 2813} 2814 2815sub end_element 2816{ 2817 my $self = shift; 2818 my $element = shift; 2819 my $sub = "$element->{Name}_"; 2820 &$sub($self, $element); 2821 #print "StateOut is $self->{State}\n"; 2822 $self->{cur_list} = pop @{ $self->{lists} }; 2823} 2824 2825sub characters 2826{ 2827 my $self = shift; 2828} 2829 2830sub ignorable_whitespace 2831{ 2832 my $self = shift; 2833} 2834 2835sub processing_instruction 2836{ 2837 my $self = shift; 2838} 2839 2840sub record_end 2841{ 2842 my $self = shift; 2843 2844} 2845 2846sub notation_decl 2847{ 2848 my $self = shift; 2849 2850 #$self->{Map}{Notations}{$notation->{Name}} = $notation; 2851} 2852 2853sub comment 2854{ 2855 my $self = shift; 2856 2857 #push @{ $self->{cur_list} }, $comment; 2858} 2859 2860 2861sub appinfo 2862{ 2863 my $self = shift; 2864 my $appinfo = shift; 2865 $self->{Map}{AppInfo} = $appinfo->{AppInfo}; 2866} 2867 2868sub conforming 2869{ 2870 my $self = shift; 2871 $self->{Map}{Conforming} = 1; 2872} 2873 2874sub warning 2875{ 2876 my $self = shift; 2877 my $error = shift; 2878 push (@{ $self->{Map}{Errors} }, $error); 2879} 2880 2881sub error 2882{ 2883 my $self = shift; 2884 my $error = shift; 2885 push (@{ $self->{Map}{Errors} }, $error); 2886} 2887 2888sub fatal_error 2889{ 2890 my $self = shift; 2891 my $error = shift; 2892 push (@{ $self->{Map}{Errors} }, $error); 2893} 2894 2895sub XMLToDBMS {} 2896sub XMLToDBMS_ {} 2897 2898sub Options {} 2899sub Options_ {} 2900 2901sub DateTimeFormats {} 2902sub DateTimeFormats_ {} 2903 2904sub Patterns 2905{ 2906 my $self = shift; 2907 my $Attributes = shift; 2908 2909 $self->{DatePattern} = $Attributes->{Date} if exists $Attributes->{Date}; 2910 $self->{TimePattern} = $Attributes->{Time} if exists $Attributes->{Time}; 2911 $self->{TimestampPattern} = $Attributes->{Timestamp} if exists $Attributes->{Timestamp}; 2912} 2913 2914sub Patterns_ {} 2915 2916sub Maps {} 2917sub Maps_ {} 2918 2919sub IgnoreRoot 2920{ 2921 my $self = shift; 2922 $self->{State} |= $States{IgnoreRoot}; 2923} 2924 2925sub IgnoreRoot_ 2926{ 2927 my $self = shift; 2928 $self->{State} &= ~$States{IgnoreRoot}; 2929} 2930 2931sub PseudoRoot 2932{ 2933 my $self = shift; 2934 2935 $self->{RelatedMap} = new XML::XMLtoDBMS::RelatedClassMap; 2936 $self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate} = 0; 2937 $self->{State} |= $States{PseudoRoot}; 2938} 2939sub PseudoRoot_ 2940{ 2941 my $self = shift; 2942 $self->{State} &= ~$States{PseudoRoot}; 2943} 2944 2945sub Table 2946{ 2947 my $self = shift; 2948 my $Attributes = shift; 2949 2950 my $tableName = $Attributes->{Name}; 2951 2952 #print "Table name $tableName\n"; 2953 2954 if ($self->{State} == $States{Root} or $self->{State} == $States{ClassTable}) 2955 { 2956 $self->{ClassMap}{Table} = $self->{Map}->addClassTable($self->{ClassMap}{Name}, $tableName); 2957 } 2958 elsif ($self->{State} == $States{PropToTable}) 2959 { 2960 $self->{PropMap}{Table} = $self->{Map}->addPropertyTable($tableName); 2961 } 2962} 2963 2964sub Table_ 2965{ 2966} 2967 2968sub ClassMap 2969{ 2970 my $self = shift; 2971 #print "State before class $self->{State}\n"; 2972 $self->{State} |= $States{ClassMap}; 2973} 2974 2975sub ClassMap_ 2976{ 2977 my $self = shift; 2978 $self->{State} &= ~$States{ClassMap}; 2979 #print "State after class $self->{State}\n"; 2980} 2981 2982sub ElementType 2983{ 2984 my $self = shift; 2985 my $Attributes = shift; 2986 2987 #print "ElementType $Attributes->{Name} while state is $self->{State}\n"; 2988 2989 if ($self->{State} == $States{ClassMap}) 2990 { 2991 $self->{ClassMap} = $self->{Map}->addClassMap($Attributes->{Name}); 2992 $self->{ClassMap}{Level} = $Attributes->{Level}; 2993 } 2994 elsif ($self->{State} == $States{Prop}) 2995 { 2996 $self->{PropMap}{Name} = $Attributes->{Name}; 2997 $self->{ClassMap}->addElementPropertyMap($self->{PropMap}); 2998 } 2999 elsif ($self->{State} == $States{Related} or $self->{State} == $States{Pseudo}) 3000 { 3001 $self->{RelatedMap}{ClassMap} = $self->{Map}->getClassMap($Attributes->{Name}); 3002 $self->{ClassMap}->addRelatedClassMap($self->{RelatedMap}); 3003 } 3004 elsif ($self->{State} == $States{IgnoreRoot}) 3005 { 3006 $self->{ClassMap} = $self->{Map}->addClassMap($Attributes->{Name}); 3007 $self->{ClassMap}{Type} = $ClassMapTypes{IgnoreRoot}; 3008 $self->{RootClassMap} = $self->{Map}->addRootClassMap($self->{ClassMap}); 3009 } 3010} 3011 3012sub ElementType_ 3013{ 3014} 3015 3016sub ToClassTable 3017{ 3018 my $self = shift; 3019 $self->{ClassMap}{Type} = $ClassMapTypes{ToClassTable}; 3020 $self->{State} |= $States{ToClassTable}; 3021} 3022 3023sub ToClassTable_ 3024{ 3025 my $self = shift; 3026 $self->{State} &= ~$States{ToClassTable}; 3027} 3028 3029sub PropertyMap 3030{ 3031 my $self = shift; 3032 $self->{PropMap} = new XML::XMLtoDBMS::PropertyMap; 3033 $self->{State} |= $States{PropertyMap}; 3034} 3035 3036sub PropertyMap_ 3037{ 3038 my $self = shift; 3039 $self->{State} &= ~$States{PropertyMap}; 3040} 3041 3042sub Attribute 3043{ 3044 my $self = shift; 3045 my $Attributes = shift; 3046 3047 $self->{PropMap}{Name} = $Attributes->{Name}; 3048 $self->{PropMap}{MultiValued} = ($Attributes->{Name} eq "Yes"); 3049 $self->{ClassMap}->addAttributePropertyMap($self->{PropMap}); 3050} 3051 3052sub Attribute_ 3053{ 3054} 3055 3056sub ToColumn 3057{ 3058 my $self = shift; 3059 3060 $self->{PropMap}{Type} = $PropertyMapTypes{ToColumn}; 3061 $self->{State} |= $States{ToColumn}; 3062} 3063 3064sub ToColumn_ 3065{ 3066 my $self = shift; 3067 $self->{State} &= ~$States{ToColumn}; 3068} 3069 3070sub Column 3071{ 3072 my $self = shift; 3073 my $Attributes = shift; 3074 my $colname = $Attributes->{Name}; 3075 3076 #print "Column name $colname while state is $self->{State}\n"; 3077 3078 if ($self->{State} == $States{RootCandidate}) 3079 { 3080 $self->{ClassMap}{Table}->addColumn($colname); 3081 push @{$self->{RootClassMap}{LinkInfo}{ChildKey}}, $colname; 3082 } 3083 elsif ($self->{State} == $States{PropToColumn}) 3084 { 3085 $self->{ClassMap}{Table}->addColumnWithCheck($colname); 3086 $self->{PropMap}{Column} = $colname; 3087 } 3088 elsif ($self->{State} == $States{PropToTable}) 3089 { 3090 $self->{PropMap}{Table}->addColumnWithCheck($colname); 3091 $self->{PropMap}{Column} = $colname; 3092 3093 } 3094 elsif ($self->{State} == $States{PropCandidate}) 3095 { 3096 if ($self->{PropMap}{LinkInfo}{ParentKeyIsCandidate}) 3097 { 3098 $self->{ClassMap}{Table}->addColumn($colname); 3099 push @{$self->{PropMap}{LinkInfo}{ParentKey}}, $colname; 3100 } 3101 else 3102 { 3103 $self->{PropMap}{Table}->addColumn($colname); 3104 push @{$self->{PropMap}{LinkInfo}{ChildKey}}, $colname; 3105 } 3106 } 3107 3108 elsif ($self->{State} == $States{PropForeign}) 3109 { 3110 3111 if ($self->{PropMap}{LinkInfo}{ParentKeyIsCandidate}) 3112 { 3113 $self->{PropMap}{Table}->addColumn($colname); 3114 push @{$self->{PropMap}{LinkInfo}{ChildKey}}, $colname; 3115 } 3116 else 3117 { 3118 $self->{ClassMap}{Table}->addColumn($colname); 3119 push @{$self->{PropMap}{LinkInfo}{ParentKey}}, $colname; 3120 } 3121 } 3122 elsif ($self->{State} == $States{RelatedCandidate} or 3123 $self->{State} == $States{PseudoCandidate}) 3124 { 3125 if ($self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate}) 3126 { 3127 $self->{ClassMap}{Table}->addColumn($colname); 3128 push @{$self->{RelatedMap}{LinkInfo}{ParentKey}}, $colname; 3129 } 3130 else 3131 { 3132 if (!defined $self->{RelatedMap}{ClassMap}{Table}) 3133 { 3134 $self->{RelatedMap}{ClassMap}{Table} = $self->{Map}->getClassTable($self->{RelatedMap}{ClassMap}{Name}); 3135 } 3136 $self->{RelatedMap}{ClassMap}{Table}->addColumn($colname); 3137 push @{$self->{RelatedMap}{LinkInfo}{ChildKey}}, $colname; 3138 } 3139 } 3140 elsif ($self->{State} == $States{RelatedForeign}) 3141 { 3142 if ($self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate}) 3143 { 3144 if (!defined $self->{RelatedMap}{ClassMap}{Table}) 3145 { 3146 $self->{RelatedMap}{ClassMap}{Table} = $self->{Map}->getClassTable($self->{RelatedMap}{ClassMap}{Name}); 3147 } 3148 $self->{RelatedMap}{ClassMap}{Table}->addColumn($colname); 3149 push @{$self->{RelatedMap}{LinkInfo}{ChildKey}}, $colname; 3150 } 3151 else 3152 { 3153 $self->{ClassMap}{Table}->addColumn($colname); 3154 push @{$self->{RelatedMap}{LinkInfo}{ParentKey}}, $colname; 3155 } 3156 } 3157} 3158 3159sub Column_ 3160{ 3161} 3162 3163sub EmptyStringIsNull 3164{ 3165 my $self = shift; 3166 $self->{Map}{EmptyStringIsNull} = 1; 3167} 3168 3169sub EmptyStringIsNull_ 3170{ 3171} 3172 3173sub CandidateKey 3174{ 3175 my $self = shift; 3176 my $Attributes = shift; 3177 my $genkey = 0; 3178 3179 $genkey = ($Attributes->{Generate} eq "Yes") 3180 if (defined $Attributes->{Generate}); 3181 3182 $self->{Map}{Generate} = $genkey; 3183 3184 my $state = $self->{State}; 3185 3186 if ($state == $States{Root}) 3187 { 3188 $self->{RootClassMap}{LinkInfo}{GenerateKey} = $genkey; 3189 } 3190 if ($state == $States{PropToTable}) 3191 { 3192 $self->{PropMap}{LinkInfo}{GenerateKey} = $genkey; 3193 } 3194 if ($state == $States{Related} or $state == $States{Pseudo}) 3195 { 3196 $self->{RelatedMap}{LinkInfo}{GenerateKey} = $genkey; 3197 } 3198 $self->{State} |= $States{CandidateKey}; 3199} 3200 3201sub CandidateKey_ 3202{ 3203 my $self = shift; 3204 $self->{State} &= ~$States{CandidateKey}; 3205} 3206 3207sub ForeignKey 3208{ 3209 my $self = shift; 3210 $self->{State} |= $States{ForeignKey}; 3211} 3212 3213sub ForeignKey_ 3214{ 3215 my $self = shift; 3216 $self->{State} &= ~$States{ForeignKey}; 3217} 3218 3219sub RelatedClass 3220{ 3221 my $self = shift; 3222 my $Attributes = shift; 3223 3224 $self->{RelatedMap} = new XML::XMLtoDBMS::RelatedClassMap; 3225 3226 #my $type = ref($self->{RelatedMap}); 3227 3228 $self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate} = ($Attributes->{KeyInParentTable} eq "Candidate"); 3229 $self->{State} |= $States{RelatedClass}; 3230} 3231 3232sub ToRootTable 3233{ 3234 my $self = shift; 3235 3236 $self->{RootClassMap} = $self->{Map}->addRootClassMap($self->{ClassMap}); 3237 $self->{RootClassMap}{LinkInfo} = {ParentKeyIsCandidate => 0}; 3238 $self->{ClassMap}{Type} = $ClassMapTypes{ToRootTable}; 3239 3240 $self->{State} |= $States{ToRootTable} 3241} 3242 3243sub ToRootTable_ 3244{ 3245 my $self = shift; 3246 $self->{State} &= ~$States{ToRootTable} 3247} 3248 3249sub RelatedClass_ 3250{ 3251 my $self = shift; 3252 $self->{State} &= ~$States{RelatedClass}; 3253} 3254 3255sub PCDATA 3256{ 3257 my $self = shift; 3258 croak "PCDtata for $self->{ClassMap}{Name} mapped more then once" 3259 if defined $self->{ClassMap}{PCDataMap}; 3260 $self->{ClassMap}{PCDataMap} = $self->{PropMap}; 3261 $self->{PropMap}{Name} = ''; 3262} 3263 3264sub PCDATA_ 3265{ 3266} 3267 3268sub OrderColumn 3269{ 3270 my $self = shift; 3271 my $Attributes = shift; 3272 my $colname = $Attributes->{Name}; 3273 my $direction = $Attributes->{Direction}; 3274 my $generate = 0; 3275 3276 $generate = ($Attributes->{Generate} eq "Yes") 3277 if defined $Attributes->{Generate}; 3278 3279 my $state = $self->{State}; 3280 3281 if ($state == $States{Root}) 3282 { 3283 $self->{RootClassMap}{ClassMap}{Table}->addColumn($colname); 3284 $self->{RootClassMap}{OrderInfo} = { OrderColumn => $colname, 3285 GenerateOrder => $generate, 3286 Direction => $direction }; 3287 } 3288 elsif ($state == $States{Prop}) 3289 { 3290 if ($self->{PropMap}{Type} = $PropertyMapTypes{ToColumn}) 3291 { 3292 #Order column is parallel to the property column in the 3293 #class table. 3294 $self->{ClassMap}{Table}->addColumn($colname); 3295 } 3296 elsif ($self->{PropMap}{Type} = $PropertyMapTypes{ToTabl}) 3297 { 3298 #Order column is in table of foreign key. 3299 if ($self->{PropMap}{LinkInfo}{ParentKeyIsCandidate}) 3300 { 3301 $self->{PropMap}{Table}->addColumn($colname); 3302 } 3303 else 3304 { 3305 $self->{ClassMap}{Table}->addColumn($colname); 3306 } 3307 } 3308 else 3309 { 3310 croak "Unknown property map type"; 3311 } 3312 $self->{PropMap}{OrderInfo} = { OrderColumn => $colname, 3313 GenerateOrder => $generate, 3314 Direction => $direction }; 3315 } 3316 elsif ($state == $States{Related} or $state == $States{Pseudo}) 3317 { 3318 #Order column is in table of foreign key. 3319 3320 if ($self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate} or $state == $States{Pseudo}) 3321 { 3322 if (!defined $self->{RelatedMap}{ClassMap}{Table}) 3323 { 3324 $self->{RelatedMap}{ClassMap}{Table} = $self->{Map}{Name}; 3325 } 3326 $self->{RelatedMap}{ClassMap}{Table}->addColumn($colname); 3327 } 3328 else 3329 { 3330 $self->{ClassMap}{Table}->addColumn($colname); 3331 } 3332 $self->{RelatedMap}{OrderInfo} = { OrderColumn => $colname, 3333 GenerateOrder => $generate, 3334 Direction => $direction }; 3335 } 3336} 3337 3338sub OrderColumn_ 3339{ 3340} 3341 3342sub ToPropertyTable 3343{ 3344 my $self = shift; 3345 my $Attributes = shift; 3346 3347 $self->{PropMap}{Type} = $PropertyMapTypes{ToPropertyTable}; 3348 $self->{PropMap}{LinkInfo}{ParentKeyIsCandidate} = ($Attributes->{KeyInParentTable} eq 'Candidate'); 3349 $self->{State} |= $States{ToPropertyTable}; 3350} 3351 3352sub ToPropertyTable_ 3353{ 3354 my $self = shift; 3355 $self->{State} &= ~$States{ToPropertyTable}; 3356} 3357 3358 3359sub Parameter 3360{ 3361 my $self = shift; 3362 my $Attributes = shift; 3363 $self->{Map}{Parameters}{$Attributes->{Name}} = undef; 3364 #print $Attributes->{Name} . "\n"; 3365} 3366 3367sub Parameter_ 3368{ 3369} 3370 3371sub Filter 3372{ 3373 my $self = shift; 3374 my $Attributes = shift; 3375 my $filter = $Attributes->{Value}; 3376 3377 my $state = $self->{State}; 3378 3379 if ($state == $States{Root}) 3380 { 3381 $self->{RootClassMap}{Filter} = $filter; 3382 } 3383 if ($state == $States{PropToTable}) 3384 { 3385 3386 $self->{PropMap}{Filter} = $filter; 3387 } 3388 if ($state == $States{Related} or $state == $States{Pseudo}) 3389 { 3390 $self->{RelatedMap}{Filter} = $filter; 3391 } 3392 # no need to change state umless there will be sublevels to this. 3393 #$self->{State} |= $States{Filter}; 3394} 3395 3396sub Filter_ 3397{ 3398} 3399 3400sub convertFormat 3401{ 3402 my $formatString = shift; 3403 3404 $formatString =~ s/YYYY/%Y/g; 3405 $formatString =~ s/YY/%y/g; 3406 $formatString =~ s/MM/%m/g; 3407 $formatString =~ s/DD/%d/g; 3408 $formatString =~ s/hh/%H/g; 3409 $formatString =~ s/mm/%M/g; 3410 $formatString =~ s/ss/%S/g; 3411 return $formatString; 3412} 3413