####################################################################################################### # # Perl module: XML::XMLtoDBMS # # By Nick Semenov, nsemenov@yahoo.com # perl port of Java package XML-DBMS v1.0 (de.tudarmstadt.ito.*) by Ron Bourret, rbourret@hotmail.com # ####################################################################################################### # # http://www.informatik.th-darmstadt.de/DVS1/staff/bourret/xmldbms/xmldbms.htm ####################################################################################################### # # fixes: # # 2000-07-18 serializeNode un-escaping # 2000-07-.. fixed complex Order by clause (was not adding all the columns) # 2000-08-24 added where clause to retrieveDocument function # 2000-08-24 fixed date conversion (was not reaching check for date format) # 2000-08-25 added startindex, numcolumns to the retrieve multipage documents # 2000-09-12 fixed SQL error handling; remove duplicate keys when there is subquery # 2000-09-18 added sorting order direction for root/pseudoroot table # 2000-09-26 null values in the key columns are now supported - reversed because of SqlFlex not supporting (? = NULL) binding # 2000-10-02 added return of the result set size when using range queries (start_index, length) # 2001-02-13 v 1.01 added missing Row::anyNull function # 2001-05-17 v.1.01.1 fixed convertDateString with more precise datetime data recognition # 2001-05-29 v.1.01.2 order column processing in processTableMaps fixed # 2001-05-29 v.1.02 replaced XML::DOM with XML::LibXML (50% performance gain in DOM creation) # 2001-11-12 v.1.03 Oracle date format recognized. # fix for ".00." ODBC integer format, removed XMLtoDBMS::Parameters # added XSLT-type parameters support, filtering of resultsets, and limited XPath-type node level conrol (see sample2.map) # # ####################################################################################################### package XML::XMLtoDBMS; ####################################################################################################### BEGIN { require XML::Parser::PerlSAX; import XML::XMLtoDBMS::MapFactory; import XML::XMLtoDBMS::DocumentInfo; import XML::XMLtoDBMS::KeyGenerator; import XML::XMLtoDBMS::Parameters; import XML::XMLtoDBMS::Order; import XML::XMLtoDBMS::Row; $VERSION = '1.02'; $NAME = 'XML::XMLtoDBMS'; @ISA = qw( Exporter ); } #use strict; use Carp; use DBI; use XML::LibXML; use Time::Local; use Date::Format; use Date::Parse; use vars qw (@ISA $VERSION $NAME %ClassMapTypes %PropertyMapTypes %ColumnMapTypes %TableMapTypes %char_entities); %ClassMapTypes = (ToRootTable => 1, ToClassTable => 2, IgnoreRoot => 3, PassThrough => 4); %PropertyMapTypes = (ToColumn => 1, ToPropertyTable => 2); %ColumnMapTypes = (ToAttribute => 1, ToElementType => 2, ToPCData => 3); %TableMapTypes = (ClassTable => 1, PropertyTable => 2); %char_entities = ( "\x09" => ' ', "\x0a" => ' ', "\x0d" => ' ', '&' => '&', '<' => '<', '>' => '>', '"' => '"', ); sub new { my $type = shift; my $dbh = shift; my $self = { DBh => $dbh }; bless $self, $type; } sub storeDocument { my $self = shift; croak "No map was set yet" if !defined $self->{Map}; if (scalar(@_) == 1 and ref($_[0]) eq "XML::LibXML::Document") { $self->{Doc} = shift; } else { my $args = {@_}; $self->{Doc} = $self->openDocument($args->{Source}); } #my $dateFormat = $self->{Map}{DateFormat}; #my $timeFormat = $self->{Map}{TimeFormat}; #my $timestampFormat = $self->{Map}{TimestampFormat}; #$self->{Parameters} = new XML::XMLtoDBMS::Parameters(DateFormat => $dateFormat, TimeFormat => $timeFormat, TimestampFormat => $timestampFormat); $self->{Parameters} = $self->{Map}{Parameters}; $self->{KeyGenerator} = new XML::XMLtoDBMS::KeyGenerator($self->{DBh}); $self->processRoot($self->{Doc}->getDocumentElement, $self->{Map}); return $self->{Doc}; } sub openDocument { my $self = shift; my $source = shift; my $parser = new XML::LibXML; if (exists $source->{File}) { return $parser->parse_file($source->{File}); } elsif (exists $source->{String}) { return $parser->parse_string($source->{String}); } else { croak "storeDocument has unknown argument" ; } } sub setMap { my $self = shift; my $mapFileName = shift; $self->{Map}->destroy if defined $self->{Map}; my $mapfactory = new XML::XMLtoDBMS::MapFactory(); $self->{Map} = $mapfactory->createMap($mapFileName, $self->{DBh}); return $self->{Map}; } sub destroy { my $self = shift; $self->{Map}->destroy if defined $self->{Map}; } sub retrieveDocument { my ($self, $tableName, $keys, $params, $startindex, $numrows, $total) = @_; my ($key, $value); croak "No map was set yet" if !defined $self->{Map}; #$self->{Doc}->dispose if defined $self->{Doc}; $self->{Doc} = new XML::LibXML::Document; #make then point to one location $self->{Parameters} = $self->{Map}{Parameters}; if (defined $params) { while(($key, $value) = each(%{$params})) { if (exists $self->{Parameters}{$key}) { $self->{Parameters}{$key} = $value ; } else { croak "parameter $key is not declared in the map"; } } } #my $dateFormat = convertFormat($self->{Map}{DateFormat}); #my $timeFormat = convertFormat($self->{Map}{TimeFormat}); #my $timestampFormat = convertFormat($self->{Map}{TimestampFormat}); #$self->{Parameters} = new XML::XMLtoDBMS::Parameters($params); my $rootTableMap = $self->{Map}->getRootTableMap($tableName); # This chunk is to execute range queries. if (defined $startindex) { $startindex--; $numrows = 1 if !defined $numrows or $numrows < 0 ; my $lastindex = $startindex + $numrows - 1; my $select = $self->{Map}->checkOutSelectStmt($rootTableMap->{TableMap}{Table}, $rootTableMap->{CandidateKey}, $rootTableMap->{OrderColumn}, $rootTableMap->{Filter}, 1); croak $self->{Map}{DB}->errstr if !defined $select or !$select->execute(); $keys = $select->fetchall_arrayref([0..$#{@{$rootTableMap->{CandidateKey}}}]); $$total = @{$keys} if defined $total ; @slice = @{$keys}[$startindex..$lastindex]; my %saw; undef %saw; @slice= grep(!$saw{join('|',@{$_})}++, @slice); $keys = \@slice; } if (defined $keys and ref($keys) eq 'ARRAY') { my $select = $self->{Map}->checkOutSelectStmt($rootTableMap->{TableMap}{Table}, $rootTableMap->{CandidateKey}, $rootTableMap->{OrderColumn}, $rootTableMap->{Filter}) if $keys > 0; croak $self->{Map}{DB}->errstr if !defined $select; foreach my $keyValues(@{$keys}) { last if !defined $keyValues; #$self->{Parameters}->setParameters($select, $keyValues, $rootTableMap->{CandidateKey}); $select->execute(@{$keyValues}) or croak $self->{DB}->errstr; $self->processRootResultSet($rootTableMap, $select, $rootTableMap->{OrderColumn}, new XML::XMLtoDBMS::Order()); #$self->{Map}->checkInSelectStmt($select); } return $self->{Doc}; } else { my $select = $self->{Map}->checkOutSelectStmt($rootTableMap->{TableMap}{Table}, $keys, $rootTableMap->{OrderColumn}, $rootTableMap->{Filter}); croak $self->{DB}->errstr if !defined $select or !$select->execute(); $self->processRootResultSet($rootTableMap, $select, $rootTableMap->{OrderColumn}, new XML::XMLtoDBMS::Order()); #$self->{Map}->checkInSelectStmt($select); return $self->{Doc}; } } sub doubleArray { $array = shift; my @newarray; foreach (@{$array}) { push @newarray, $_; push @newarray, $_; } return \@newarray unless wantarray; @newarray; } sub processRootResultSet { my ($self, $rootTableMap, $rs, $orderColumn, $parentOrder) = @_; my $row = new XML::XMLtoDBMS::Row(); my $firstRow = 1; #Process the root result set. my $parent = $self->addIgnoredRoot($rootTableMap); $self->processClassResultSet($parent, $rootTableMap->{TableMap}, $rs, $orderColumn, $parentOrder); } sub processClassResultSet { my ($self, $parent, $rsMap, $rs, $orderColumn, $parentOrder) = @_; my $row = new XML::XMLtoDBMS::Row(); my $childOrder = new XML::XMLtoDBMS::Order(); my $resRow; #We currently don't support pass-through elements. However, this will #be the place to add them in the future. #parent = addPassThroughElements(parent, rsMap); #while ($resRow = $rs->fetch) $resRow = $rs->fetchall_arrayref; $rs->finish; foreach (@{$resRow}) { #print "Processing class $rsMap->{ElementType}\n"; #Create an element node for the row and insert it into the #parent node. #@{$row->{ColumnValues}} = @{$resRow}; #fix for DBI::ODBC - integer values are returned with ".00." at the end - cut them off foreach (@{$_}) { s/\.00\.//g if $_}; @{$row->{ColumnValues}} = @{$_}; my $child = $self->{Doc}->createElement($rsMap->{ElementType}); $parentOrder->insertChild($parent, $child, getOrderValue($row, $orderColumn), $rsMap->{Level}); #Process the columns in the row, then process the related tables #for the row. $childOrder->clear; $self->processColumns($row, $rsMap->{ColumnMaps}, $child, $childOrder); $self->processRelatedTables($row, $rsMap, $child, $childOrder); } } sub processColumns { my ($self, $row, $columnMaps, $parent, $parentOrder) = @_; foreach (@{$columnMaps}) { $self->processColumn($row, $_, $parent, $parentOrder); } } sub processColumn { my ($self, $row, $columnMap, $parent, $parentOrder) = @_; #Get the data value. If the data value is a null reference, then the #corresponding column is NULL. In this case, we simply don't create #the element/attribute/PCDATA. my $dataValue = $self->getDataValue($row, $columnMap->{Column}); return if !defined $dataValue; my $orderValue = $self->getOrderValue($row, $columnMap->{OrderColumn}); my ($property, $child, $pcData); if ($columnMap->{Type} == $ColumnMapTypes{ToElementType}) { $property = $columnMap->{Property}; $child = $self->{Doc}->createElement($property); $parentOrder->insertChild($parent, $child, $orderValue); $pcData = $self->{Doc}->createTextNode($dataValue); $child->appendChild($pcData); } elsif ($columnMap->{Type} == $ColumnMapTypes{ToAttribute}) { #Set the attribute. Note that if the attribute is multi-valued, we #get the current attribute value first, then append the new value #to it. Because multi-valued attributes must be stored in a #property table, we don't need to worry about the order column -- #the result set over the property table is already sorted. $property = $columnMap->{Property}; if (!$columnMap->{MultiValued}) { $parent->setAttribute($property, $dataValue); } else { my $string = $parent->getAttribute($property); if (length($string)) { $string .= " "; } $parent->setAttribute($property, $string . $dataValue); } } elsif ($columnMap->{Type} = $ColumnMapTypes{ToPCData}) { $pcData = $self->{Doc}->createTextNode($dataValue); $parentOrder->insertChild($parent, $pcData, $orderValues); } } sub processRelatedTables { my ($self, $row, $rsMap, $parent, $parentOrder) = @_; my $select; my $i = 0; foreach (@{$rsMap->{RelatedTables}}) { $select = $self->{Map}->checkOutSelectStmtByTable($rsMap->{Table}{Number}, $i); #$self->{Parameters}->setParameters($select, $row, $rsMap->{ParentKeys}[$i]); my $params = $row->getColumnValues($rsMap->{ParentKeys}[$i]); croak "select statement is not defined" if !defined $select; croak $self->{Map}{DB}->errstr if !$select->execute(@{$params}); if ($_->{Type} == $TableMapTypes{ClassTable}) { $self->processClassResultSet($parent, $_, $select, $rsMap->{OrderColumns}[$i], $parentOrder); } elsif ($_->{Type} == $TableMapTypes{PropertyTable}) { $self->processPropResultSet($parent, $_, $select, $parentOrder); } $self->{Map}->checkInSelectStmt($select, $rsMap->{Table}{Number}, $i++); } } sub processPropResultSet { my ($self, $parent, $rsMap, $stmt, $parentOrder) = @_; my $row = new XML::XMLtoDBMS::Row(); my $resRow; #while ($resRow = $rs->fetch) $resRow = $stmt->fetchall_arrayref; $stmt->finish; foreach (@{$resRow}) { #@{$row->{ColumnValues}} = @{$resRow}; @{$row->{ColumnValues}} = @{$_}; $self->processColumns($row, $rsMap->{ColumnMaps}, $parent, $parentOrder); } } sub getDataValue { my ($self, $row, $column) = @_; my $datetime; return undef if ! defined $row->{ColumnValues}[$column->{Number} - 1]; my $value = $row->getColumnValue($column); #reformatting of the date, time and timestamp should be done here. if ($value =~ /^\d{2}[\/-]\d{2}[\/-](\d{2})?\d{2}\s*/ || $value =~ /^\d{2}\-[A-Za-z]{3}\-(\d{2})?\d{2}\s*/ || $value =~ /^\d{4}[\/-]\d{2}[\/-]\d{2}\s*/ ) { $datetime = str2time($value); if ($datetime) { if ($') { $value = time2str($self->{Parameters}{TimestampFormat}, str2time($value)); } else { $value = time2str($self->{Parameters}{DateFormat}, str2time($value)); } } } return $value; } sub getOrderValue { my ($self, $row, $orderColumn) = @_; return -1 if (!defined $orderColumn or !defined $row->{ColumnValues}[$orderColumn->{Number} - 1]); return $row->{ColumnValues}[$orderColumn->{Number} - 1]; } sub addIgnoredRoot { my $self = shift; my $rootMap = shift; #If there is no ignored root element, simply return the current #root element node. return $self->{Doc} if !defined $rootMap->{IgnoredRootType}; my $ignoredRootType = $rootMap->{IgnoredRootType}; my $ignoredRoot = $self->{Doc}->getDocumentElement; if (!defined $ignoredRoot) { $ignoredRoot = $self->{Doc}->createElement($ignoredRootType); $self->{Doc}->setDocumentElement($ignoredRoot); } elsif ($ignoredRoot->getName ne $ignoredRootType) { croak "More than one ignored root element type specified: $ignoredRoot->getName and $ignoredRootType"; } return $ignoredRoot; } sub processRoot { my ($self, $root, $map) = @_; my $docInfo = new XML::XMLtoDBMS::DocumentInfo(); my $rootMap = $map->{RootClassMaps}{$root->getName}; if (!defined $rootMap) { croak "Root element not mapped to root table or ignored: ". $root->getName; } if ($rootMap->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}) { $self->processRootElement($docInfo, $rootMap, $root, 1); } elsif ($rootMap->{ClassMap}{Type} == $ClassMapTypes{IgnoreRoot}) { my $childOrder = 1; my $child = $root->getFirstChild; while (defined $child) { if ($child->getType != XML_TEXT_NODE) { my $childMap = $rootMap->{ClassMap}{SubElementTypeMaps}{$child->getName}; if (defined $childMap) { croak "If the root element is ignored, any mapped children must be mapped to class tables. " . $child->getName . " is not." if $childMap->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}; $self->processRootElement($docInfo, $childMap, $child, $childOrder); } $childOrder++; } $child = $child->getNextSibling; } } else { croak "Root element must be mapped to a root table or ignored. " . $root->getName . " is not."; } #return $docInfo; } sub processRootElement { my ($self, $docInfo, $relatedClassMap, $root, $orderInParent) = @_; my ($key, $keyColumns); #print "Calling to process root element " . $root->getName ."\n"; my $row = $self->createClassRow(undef, $relatedClassMap, $root, $orderInParent); if (defined $relatedClassMap->{LinkInfo}) { $keyColumns = $relatedClassMap->{LinkInfo}{ChildKey}; $key = $row->getColumnValues($keyColumns); } $docInfo->addInfo($relatedClassMap->{ClassMap}{Table}, $keyColumns, $key, $relatedClassMap->{OrderInfo}); } sub createClassRow { my $self = shift; my $parentRow = shift; my $rcm = shift; my $classNode = shift; my $orderInParent = shift; my $fkChildren = []; my $classRow = new XML::XMLtoDBMS::Row(Table => $rcm->{ClassMap}{Table}); if ($rcm->{LinkInfo}{ParentKeyIsCandidate}) { setChildKey($parentRow, $classRow, $rcm->{LinkInfo}); } else { $self->generateChildKey($classRow, $rcm->{LinkInfo}); } #BUG! Notice that the order is always assumed to be in the child #class table. The mapping language supports placing it in either #the parent or child tables, but the code does not -- for more #information, see the bug file. (When this bug is fixed, care #must be taken with the root element. In this case, the order #column is always in the "child" (root) table, regardless of what #parentKeyIsCandidate says.) generateOrder($classRow, $rcm->{OrderInfo}, $orderInParent); $self->processAttributes($classRow, $rcm->{ClassMap}, $classNode); $self->processChildren($classRow, $rcm->{ClassMap}, $classNode, $fkChildren); $self->insertRow($rcm->{ClassMap}{Table}, $classRow); $self->processFKNodes($classRow, $fkChildren); return $classRow; } sub createPropRow { my ($self, $parentRow, $propMap, $propNode, $orderInParent) = @_; #This method creates and inserts a row in a property table. If the #key used to link the row to its parent is a candidate key in this #table, it is generated if necessary. Otherwise, the candidate key #from the parent is set in this table as a foreign key. my $propRow = new XML::XMLtoDBMS::Row(Table => $propMap->{Table}); if ($propMap->{LinkInfo}{ParentKeyIsCandidate}) { #If the candidate key linking this class to its parent class is #in the parent's table, set that key in the child row now. Otherwise, #generate the candidate key in the current row. setChildKey($parentRow, $propRow, $propMap->{LinkInfo}); } else { generateChildKey($propRow, $propMap->{LinkInfo}); } #BUG! Notice that the order is always assumed to be in the property #table. The mapping language supports placing it in either the #parent or child tables, but the code does not -- for more #information, see the bug file. generateOrder($propRow, $propMap->{OrderInfo}, $orderInParent); setPropertyColumn($propRow, $propMap->{Column}, $propNode); insertRow($propMap->{Table}, $propRow); return $propRow; } sub generateChildKey { my $self = shift; my $childRow = shift; my $linkInfo = shift; my $keyGenerator = $self->{KeyGenerator}; $childRow->setColumnValues($linkInfo->{ChildKey}, $keyGenerator->generateKey($childRow->{Table}, $linkInfo->{ChildKey})) if ($linkInfo->{GenerateKey}); } sub generateParentKey { my ($self, $parentRow, $linkInfo) = @_; #Generate the candidate key in the parent's table if: (a) it is #supposed to be generated, and (b) it has not already been generated. #The latter condition is necessary because the parent table may be #linked with the same key to multiple child tables, so the key might #have already been set when processing a different child. This code #assumes that no key columns in the parent are nullable, so a null in #any column indicates that the key has not been generated. if ($linkInfo->{GenerateKey} and $parentRow->anyNull($linkInfo->{ParentKey})) { my $keyGenerator = $self->{KeyGenerator}; $parentRow->setColumnValues($linkInfo->{ParentKey}, $keyGenerator->generateKey($parentRow->{Table}, $linkInfo->{ParentKey})); } } sub generateOrder { my $row = shift; my $orderInfo = shift; my $orderInParent = shift; map {$row->setColumnValue($_->{OrderColumn}, $orderInParent) if ($_->{GenerateOrder});} @{$orderInfo}; } sub processFKNodes { my ($self, $parentRow, $fkNodes) = @_; my $fkNode; #This method creates and inserts a row in a class or property table. #The candidate key used to link the row to its parent is in the #parent's table. foreach $fkNode (@{$fkNodes}) { if (ref($fkNode->{Map}) eq 'XML::XMLtoDBMS::PropertyMap') { createPropRow($parentRow, $fkNode->{Map}, $fkNode->{Node}, $fkNode->{OrderInParent}); } else { $self->createClassRow($parentRow, $fkNode->{Map}, $fkNode->{Node}, $fkNode->{OrderInParent}); } } } sub setParentKey { my ($parentRow, $childRow, $linkInfo) = @_; $parentRow->setColumnValues($linkInfo->{ParentKey}, $childRow->getColumnValues($linkInfo->{ChildKey})); } sub setChildKey { my ($parentRow, $childRow, $linkInfo) = @_; $childRow->setColumnValues($linkInfo->{ChildKey}, $parentRow->getColumnValues($linkInfo->{ParentKey})); } sub processAttributes { my ($self, $elementRow, $classMap, $elementNode) = @_; my $savedAttrs = []; return if $elementNode->getType != XML_ELEMENT_NODE; #replaces getAttributes from XML::DOM my @attribs = $elementNode->findnodes('@*'); return if @attribs == 0; my ($attr, $attrMap, $attrOrder, $attributes); #my $attribs = $elementNode->getAttributes; for (my $i = 0; $i < $#attribs + 1; $i++) { $attr = $attribs[$i]; $attrMap = $classMap->{AttributeMaps}{$attr->getName}; next if !defined $attrMap; $attrOrder = 1; if ($attrMap->{MultiValued}) { #If the attribute is multi-valued, then process each value as a #separate attribute. We construct fake attributes for this #purpose; the names of these attributes are unimportant, as we #already have the AttributeMap. Order refers to the order of the #value in the attribute, not order of the attribute in the #element (attributes are unordered). my @attributes = split / /, $attr->getNodeValue; foreach (@attributes) { my $fake = $self->{Doc}->createAttribute("fake"); $fake->setNodeValue($_); $self->processProperty($elementRow, $attrMap, $fake, $attrOrder, $savedAttrs); $attrOrder++; } } else { $self->processProperty($elementRow, $attrMap, $attr, $attrOrder, $savedAttrs); } } } sub processChildren { my ($self, $parentRow, $parentMap, $parentNode, $fkChildren) = @_; my $child = $parentNode->getFirstChild; my $childOrder = 1; my $childMap; while (defined $child) { if ($child->getType == XML_TEXT_NODE) { $childMap = $parentMap->{PCDataMap}; } elsif ($child->getType == XML_ELEMENT_NODE) { $childMap = $parentMap->{SubElementTypeMaps}{$child->getName}; } if (defined $childMap) { if (ref($childMap) eq 'XML::XMLtoDBMS::PropertyMap') { $self->processProperty($parentRow, $childMap, $child, $childOrder, $fkChildren); } elsif (ref($childMap) eq 'XML::XMLtoDBMS::RelatedClassMap') { $self->processRelatedClass($parentRow, $childMap, $child, $childOrder, $fkChildren); } #PASSTHROUGH! When we support pass-through elements, we will #need to check if the child has been mapped as pass-through. } $child = $child->getNextSibling; $childOrder++; } } sub insertRow { my ($self, $table, $row) = @_; my $p = $self->{Map}->checkOutInsertStmt($table); if (defined $p) { $self->setParameters($p, $row, $table->{Columns}); $p->execute() or croak $self->{Map}{DB}->errstr; $self->{Map}->checkInInsertStmt($p, $table); } else { croak "SQL statement failed"; } } sub setParameters { my ($self, $preparedStmt, $row, $columns) = @_; my $i = 0; if (ref($row) eq 'XML::XMLtoDBMS::Row') { foreach (@{$columns}) { $preparedStmt->bind_param(++$i, $row->getColumnValue($_)); } } else { croak "Not a row passes to set parameters"; } } sub processProperty { my ($self, $parentRow, $propMap, $propNode, $orderInParent, $fkNodes) = @_; if ($propMap->{Type} == $PropertyMapTypes{ToColumn}) { generateOrder($parentRow, $propMap->{OrderInfo}, $orderInParent); $self->setPropertyColumn($parentRow, $propMap->{Column}, $propNode); } elsif($propMap->{Type} == $PropertyMapTypes{ToPropertyTable}) { if ($propMap->{LinkInfo}{ParentKeyIsCandidate}) { #If the key linking the class table to the property table is #a candidate key in the class table and a foreign key in the #property table, generate that key now and save the node #for later processing (see FKNode). $self->generateParentKey($parentRow, $propMap->{LinkInfo}), push @{$fkNodes}, {Node => $propNode, Map => $propMap, OrderInParent => $orderInParent} } else { #If the key linking the class table to the property table is #a candidate key in the property table and a foreign key in the #class table, create the row now, then set the foreign key in #the parent (class) table. my $propRow = createPropRow(undef, $propMap, $propNode, $orderInParent); setParentKey($parentRow, $propRow, $propMap->{LinkInfo}); } } } sub processRelatedClass { my ($self, $parentRow, $rcm, $classNode, $orderInParent, $fkNodes) = @_; my $nodeName; if ($rcm->{ClassMap}{Type} == $ClassMapTypes{ToClassTable}) { if ($rcm->{LinkInfo}{ParentKeyIsCandidate}) { #If the key linking the class table to the related class table #is a candidate key in the class table and a foreign key in the #related class table, generate that key now and save the node #for later processing (see FKNode). $self->generateParentKey($parentRow, $rcm->{LinkInfo}); push @{$fkNodes}, {Node => $classNode, Map => $rcm, OrderInParent => $orderInParent}; } else { #If the key linking the class table to the related class table #is a candidate key in the related class table and a foreign #key in the class table, create the row now, then set the #foreign key in the parent (class) table. my $classRow = $self->createClassRow(undef, $rcm, $classNode, $orderInParent); setParentKey($parentRow, $classRow, $rcm->{LinkInfo}); } } elsif ($rcm->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}) { $nodeName = $classNode->getName; croak "Non-root element mapped to root table: $nodeName" } elsif ($rcm->{ClassMap}{Type} == $ClassMapTypes{IgnoreRoot}) { $nodeName = $classNode->getName; croak "Non-root element ignored: $nodeName" } elsif ($rcm->{ClassMap}{Type} == $ClassMapTypes{PassThrough}) { $nodeName = $classNode->getName; croak "Pass-through not implemented yet: $nodeName" } else { $nodeName = $classNode->getName; croak "Node map is of unknown type : $nodeName" } } sub _escape { #my $self = shift; my $string = shift; $string =~ s/([\x09\x0a\x0d&<>"])/$char_entities{$1}/ge; return $string; } sub setPropertyColumn { my ($self, $propRow, $propColumn, $propNode) = @_; my ($string, $convertedString); if ($propNode->getType == XML_ELEMENT_NODE) { map {$string .= $_->toString if $_->getType == XML_TEXT_NODE or $_->getType == XML_ELEMENT_NODE;} $propNode->getChildnodes(); } else { $string = $propNode->getData; } #If empty strings are treated as NULLs, then check the length of #the property value and, if it is 0, set the value to null, which #is later interpreted as NULL. if ($self->{Map}->{EmptyStringIsNull}) { if (length($string) == 0) { $string = undef; } } $convertedString = convertDateString($self->{Parameters}{TimestampFormat}, $string); return $propRow->setColumnValue($propColumn, $convertedString) if $convertedString; $convertedString = convertDateString($self->{Parameters}{DateFormat}, $string); return $propRow->setColumnValue($propColumn, $convertedString) if $convertedString; $convertedString = convertDateString($self->{Parameters}{TimeFormat}, $string); return $propRow->setColumnValue($propColumn, $convertedString) if $convertedString; $propRow->setColumnValue($propColumn, $string); } sub convertDateString { my $fmtStr = shift; my $string = shift; $string =~ s/\s*$//; return undef unless (length($fmtStr) == length($string)) ; my $sRE = $fmtStr; $sRE =~ s/YY/\\d{2}/ if (not $sRE =~ s/YYYY/\\d{4}/); $sRE =~ s/MM/\\d{2}/; $sRE =~ s/DD/\\d{2}/; $sRE =~ s/hh/\\d{2}/; $sRE =~ s/mm/\\d{2}/; $sRE =~ s/ss/\\d{2}/; $sRE =~ s/AM/(AM|PM)/; return undef unless($string =~ /^($sRE)$/); my ($year, $month, $day, $hour, $minute, $second); my $yearIndex4 = index($fmtStr, 'YYYY'); my $yearIndex2 = index($fmtStr, 'YY') if $yearIndex4 == -1; my $monthIndex = index($fmtStr, 'MM'); my $dayIndex = index($fmtStr, 'DD'); my $hourIndex = index($fmtStr, 'hh'); my $minuteIndex = index($fmtStr, 'mm'); my $secondIndex = index($fmtStr, 'ss'); my $AMPMIndex = index($fmtStr, 'PM'); if ($yearIndex4 != -1) { $year = substr($string, $yearIndex4, 4); } elsif ($yearIndex2 != -1) { $year = substr($string, $yearIndex2, 2); } $month = substr($string, $monthIndex, 2) - 1 if $monthIndex != -1; $day = substr($string, $dayIndex, 2) if $dayIndex != -1; if ($hourIndex != -1) { $hour = substr($string, $hourIndex, 2); if (substr($string, $AMPMIndex, 2) eq 'PM') { #print 'a'.$hour; $hour += 12 unless($hour == 12); } if (substr($string, $AMPMIndex, 2) eq 'AM') { #print 'b'.$hour; $hour -= 12 if $hour == 12; } } $minute = substr($string, $minuteIndex, 2) if $minuteIndex != -1; $second = substr($string, $secondIndex, 2) if $secondIndex != -1; my @lt = localtime(time); $month = $lt[4] unless(defined $month); $day = $lt[3] unless(defined $day); $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5] unless(defined $year); $hour ||= 0 unless(defined $hour); $minute ||= 0 unless(defined $minute); $second ||= 0 unless(defined $second); return undef unless($month <= 11 && $day >= 1 && $day <= 31 && $hour <= 23 && $minute <= 59 && $second <= 59); my $result = timelocal($second, $minute, $hour, $day, $month, $year); return undef unless(defined $result); return time2str("%m/%d/%Y", $result); #disabled for AcctFlex date field. #if ($hour + $minute + $second == 0){ # return time2str("%m/%d/%Y", $result); #} else { # return time2str("%m/%d/%Y %X", $result); #} } ###################################################################### package XML::XMLtoDBMS::KeyGenerator; ###################################################################### #use strict; sub new { my $type = shift; #my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; my $self = {DBh => shift}; bless $self, $type; $self->initialize; return $self; } sub initialize { my $self = shift; } sub generateKey { my ($self, $table, $childKey) = @_; my $tableName = $table->{Name}; my $columnName = $childKey->[0]->{Name}; my $selectString = "select max($columnName) from $tableName"; my $maxValue = $self->{DBh}->selectrow_array($selectString); my $newValue = $maxValue + 1; $newValue = ' 'x(length($maxValue)-length($newValue)) . $newValue; #print $newValue . "\n"; return [$newValue]; } ###################################################################### package XML::XMLtoDBMS::DocumentInfo; ###################################################################### #use strict; sub new { my $type = shift; my $self = {Tables => [], KeyColumns => [], Keys => [], OrderColumns => []}; return bless $self, $type; } sub addInfo { my $self = shift; push @{$self->{Tables}}, shift; push @{$self->{KeyColumns}}, shift; push @{$self->{Key}}, shift; push @{$self->{OrderColumns}}, shift; } ###################################################################### package XML::XMLtoDBMS::Row; ###################################################################### #use strict; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; $self->{ColumnValues} = []; return bless $self, $type; } sub setColumnValue { my ($self, $column, $value) = @_; $self->{ColumnValues}[$column->{Number} - 1] = $value; } sub setColumnValues { my ($self, $columns, $values) = @_; my $i = 0; foreach (@{$columns}) { $self->{ColumnValues}[$_->{Number} - 1] = $values->[$i++]; } } sub getColumnValue { my ($self, $column) = @_; my $value = $self->{ColumnValues}[$column->{Number} - 1]; $value =~ s/\s+$// if $value; #print "getting column value $value\n"; return $value; } sub getColumnValues { my ($self, $columns) = @_; my $values = []; my $i = 0; push @{$values}, $self->getColumnValue($columns->[$i++]) foreach(@{$columns}); return $values; } sub anyNull { my ($self, $columns) = @_; foreach (@{$columns}) { return 1 if !defined $self->{ColumnValues}[$_->{Number} - 1]; } return 0 } ###################################################################### package XML::XMLtoDBMS::Column; ###################################################################### #use strict; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $type; } ###################################################################### package XML::XMLtoDBMS::Order; ###################################################################### #use strict; use Carp; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $type; } sub clear { my $self = shift; $self->{FirstUnorderedChild} = undef; $self->{Start} = undef; } sub insertChild { my ($self, $parent, $child, $orderValue, $level) = @_; #Insert a child in the correct position in its parent. This code #really ought to be rewritten to use a binary search. #If the child is not ordered, then save it as the last child. If this #is the first unordered child, save it so we can place ordered #children before it. if (ref($parent) eq 'XML::LibXML::Document') { croak "more then one elements " . $child->getName . " in the root level" if defined $parent->documentElement; $parent->setDocumentElement($child); return; } if (defined $level) { if ($level ne "") { my @newNodes = $parent->findnodes($level); if ($#newNodes > -1) { $parent = $newNodes[0]; } else { my $newParent; $newParent = $parent->getOwnerDocument->createElement($level); $parent->appendChild($newParent); $parent = $newParent; } } } if ($orderValue == -1) { $parent->appendChild($child); $self->{FirstUnorderedChild} = $child if !defined $self->{FirstUnorderedChild}; return; } #Insert the child before the first node with a higher order value. #This is efficient if the children are added in reverse order #(highest order first), which is easy to do for children #corresponding to entire rows in class or columns in property tables #because we can sort the table on a single column. It is very #inefficient for children added in random order, such as those #corresponding to columns in a class table, which are accessed from #first column to last column. my $current = $self->{Start}; my ($save, $newOrderNode); while (defined $current) { if ($orderValue > $current->{OrderValue}) { $save = $current; $current = $current->{Next}; } else { #Insert the child and update the linked list of order info. $parent->insertBefore($child, $current->{Node}); $newOrderNode = {OrderValue => $orderValue, Node => $child, Next => $current}; if (!defined $save) { $self->{Start} = $newOrderNode; } else { $save->{Next} = {}; } return; } } #If the order value is greater than the order values of all current #children, insert the child after the ordered children and before the #unordered children. if (!defined $current) { $newOrderNode = {OrderValue => $orderValue, Node => $child, Next => $current}; print $child . $self->{FirstUnorderedChild} . "\n"; $parent->insertBefore($child, $self->{FirstUnorderedChild}); if (!defined $self->{Start}) { $self->{Start} = $newOrderNode; } else { $save->{Next} = $newOrderNode; } } } ###################################################################### package XML::XMLtoDBMS::ColumnMap; ###################################################################### #use strict; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $type; } ###################################################################### package XML::XMLtoDBMS::Table; ###################################################################### #use strict; use Carp; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; #name is passed as argument return bless $self, $type; } sub addColumn { my $self = shift; my $column = shift; return if exists($self->{Columns}{$column}); #print "added column $column to a table $self->{Name}\n" if defined $self->{Name}; $self->{Columns}{$column} = 0; #column only added } sub addColumnWithCheck { my $self = shift; my $column = shift; #print "adding column $column to a table $self->{Name}\n"; croak "More than one property mapped to the column $column in the table $self->{Name}" if (exists $self->{Columns}{$column} and $self->{Columns}{$column}); $self->{Columns}{$column} = 1; #now column is mapped } ###################################################################### package XML::XMLtoDBMS::TableMap; ###################################################################### #use strict; use Carp; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $type; } sub addElementTypeColumnMap { my $self = shift; my $column = shift; croak "More than one property mapped to the $column->{Name} column in the $self->{Table}{Name} table." if (exists( $self->{ElementTypeColumnMaps}{$column}) or exists($self->{PropertyColumnMaps}{$column})); my $columnMap = new XML::XMLtoDBMS::ColumnMap(Column => $column); return $self->{ElementTypeColumnMaps}{$column} = $columnMap; } sub addPropertyColumnMap { my $self = shift; my $column = shift; croak "More than one property mapped to the $column->{Name} column in the $self->{Table}{Name} table." if (exists( $self->{ElementTypeColumnMaps}{$column}) or exists($self->{PropertyColumnMaps}{$column})); my $columnMap = new XML::XMLtoDBMS::ColumnMap(Column => $column); return $self->{PropertyColumnMaps}{$column} = $columnMap; } ###################################################################### package XML::XMLtoDBMS::ClassMap; ###################################################################### #use strict; use Carp; sub new { my $type = shift; my $name = shift; my $self = { Name => $name, Type => 0, Table => undef, AttributeMaps => {}, SubElementTypeMaps => {}, PropMap => undef }; return bless $self, $type; } sub addElementPropertyMap { my $self = shift; my $propMap = shift; my $name = $propMap->{Name}; croak "Element type $name is mapped more then once as a related class or property of $self->{Name}" if exists($self->{SubElementTypeMaps}{$name}); #print "Added property map (element) $propMap->{Name} for class map $self->{Name}\n"; $self->{SubElementTypeMaps}{$name} = $propMap; } sub addAttributePropertyMap { my $self = shift; my $propMap = shift; my $name = $propMap->{Name}; croak "Element type $name is mapped more then once as a property of $self->{Name}" if exists($self->{AttributeMaps}{$name}); #print "Added property map (attribute) $propMap->{Name} for class map $self->{Name}\n"; $self->{AttributeMaps}{$name} = $propMap; } sub addRelatedClassMap { my $self = shift; my $relatedMap = shift; my $name = $relatedMap->{ClassMap}{Name}; croak "Element type $name mapped more than once as a related class or property of $self->{Name}\n" if exists($self->{SubElementTypeMaps}{$name}); #print "Added related map $name for class map $self->{Name}\n"; $self->{SubElementTypeMaps}{$name} = $relatedMap; } ###################################################################### package XML::XMLtoDBMS::RootTableMap; ###################################################################### use Carp; #use strict; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $type; } ###################################################################### package XML::XMLtoDBMS::RootClassMap; ###################################################################### use Carp; #use strict; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $type; } ###################################################################### package XML::XMLtoDBMS::RelatedClassMap; ###################################################################### #use strict; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; #my $self = {ClassMap => undef, OrderInfo => [], LinkInfo => { ParentKey => [], ChildKey => [], GenerateKey => 0, ParentKeyIsCandidate => 0}}; return bless $self, $type; } ###################################################################### package XML::XMLtoDBMS::PropertyMap; ###################################################################### #use strict; sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; return bless $self, $type; } ###################################################################### package XML::XMLtoDBMS::Map; ###################################################################### use Carp; use vars qw(%ColumnMapTypes %PropertyMapTypes %ClassMapTypes %TableMapTypes); #use strict; BEGIN { %ColumnMapTypes = (ToAttribute => 1, ToElementType => 2, ToPCData => 3); %PropertyMapTypes = (ToColumn => 1, ToPropertyTable => 2); %ClassMapTypes = (ToRootTable => 1, ToClassTable => 2, IgnoreRoot => 3, PassThrough => 4); %TableMapTypes = (ClassTable => 1, PropertyTable => 2); } sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; $self = { PropertyTables => {}, ClassTablesByElemType => {}, ClassTablesByNames => {}, ClassMaps => {}, RootClassMaps => {}, MappedClasses => {}, TableMaps => {}, RootTableMaps => {}, MappedTables => {}, GenerateKeys => 0, EmptyStringIsNull => 0 }; return bless $self, $type; } sub destroy { my $self = shift; my $stmt; if (defined $self->{InsertStacks}) { foreach (@{$self->{InsertStacks}}) { foreach $stmt (@{$_}) { undef $stmt; } } undef $self->{InsertStacks}; } if (defined $self->{SelectStacks}) { foreach (@{$self->{SelectStacks}}) { foreach (@{$_}) { foreach (@{$_}) { undef $_; } } } undef $self->{SelectStacks}; } } sub addClassMap { my $self = shift; my $name = shift; croak "Class $name is already mapped" if exists($self->{MappedClasses}{$name}); $self->{MappedClasses}{$name} = 1; return $self->getClassMap($name); } sub getClassMap { my $self = shift; my $name = shift; return $self->{ClassMaps}{$name} if exists ($self->{ClassMaps}{$name}); #print "Added new classMap for $name\n"; return $self->{ClassMaps}{$name} = new XML::XMLtoDBMS::ClassMap($name); } sub getNewClassMap { my $self = shift; my $name = shift; return $self->{NewClassMaps}{$name} if exists ($self->{NewClassMaps}{$name}); #print "Added new classMap for $name\n"; return $self->{NewClassMaps}{$name} = new XML::XMLtoDBMS::ClassMap($name); } sub addClassTable { my $self = shift; my $classMapName = shift; my $tableName = shift; croak "More than one class mapped to the table: $tableName" if exists($self->{ClassTablesByName}{$tableName}); croak "The table $tableName is used as both a property table and a class table." if exists($self->{PropertyTables}{$tableName}); my $table = $self->{ClassTablesByElementType}{$classMapName}; if (defined $table) { $table->{Name} = $tableName; } else { $table = new XML::XMLtoDBMS::Table(Name => $tableName); $self->{ClassTablesByElementType}{classMapName} = $table; } $self->{ClassTablesByName}{$tableName} = $table; return $table; } sub getClassTable { my $self = shift; my $elemTypeName = shift; my $table = $self->{ClassTablesByElementType}{$elemTypeName}; if (!defined $table) { $table = new XML::XMLtoDBMS::Table; #we do not know table name yet $self->{ClassTablesByElementType}{$elemTypeName} = $table; } return $table; } sub addRootClassMap { my $self = shift; my $classMap = shift; my $name = $classMap->{Name}; my $rootClassMap = new XML::XMLtoDBMS::RootClassMap(ClassMap => $classMap); $self->{RootClassMaps}{$name} = $rootClassMap; return $rootClassMap; } sub getRootTableMap { my $self = shift; my $rootTable = shift; croak "Table not mapped as a root table: $rootTable" if (!defined $self->{RootTableMaps}{$rootTable}); return $self->{RootTableMaps}{$rootTable}; } sub createTableMapsFromClassMaps { my $self = shift; $self->checkRelatedClasses; $self->processClassMaps; $self->processRootClassMaps; #print "Ended somehow\n"; } sub checkRelatedClasses { my $self = shift; #print "Checking related classes\n"; foreach my $className (keys %{$self->{ClassMaps}}) { #print "checking if $className class is mapped..."; croak "Element type $className was listed as a related class but was never mapped." if (!exists( $self->{MappedClasses}{$className})); #print "Yes\n"; } } sub processClassMaps { my $self = shift; foreach my $className (keys %{$self->{ClassMaps}}) { my $classMap = $self->{ClassMaps}{$className}; #print "Processing class map for class $className with type $classMap->{Type}...\n"; next if ($classMap->{Type} == $ClassMapTypes{IgnoreRoot} or $classMap->{Type} == $ClassMapTypes{PassThrough}); my $tableMap = $self->addClassTableMap($classMap); #print "processing Attributes...\n"; $self->processSubMaps($classMap->{AttributeMaps}, $tableMap, $ColumnMapTypes{ToAttribute}); #print "processing SubElementTypes...\n"; $self->processSubMaps($classMap->{SubElementTypeMaps}, $tableMap, $ColumnMapTypes{ToElementType}); $self->processPropertyMap($classMap->{PCDataMap}, $tableMap, $ColumnMapTypes{ToPCData}) if defined $classMap->{PCDataMap}; } } sub processSubMaps { my $self = shift; my $subMap = shift; my $classTableMap = shift; my $columnType = shift; foreach my $name (keys %{$subMap}) { my $Map = $subMap->{$name}; my $type = ref($Map); if ($type eq 'XML::XMLtoDBMS::PropertyMap') { $self->processPropertyMap($Map, $classTableMap, $columnType); } elsif ($type eq 'XML::XMLtoDBMS::RelatedClassMap') { $self->processRelatedClassMap($Map, $classTableMap, $columnType); } else { croak "Map $name is of wrong type $type"; } } } sub processPropertyMap { my $self = shift; my $propMap = shift; my $classTableMap = shift; my $columnType = shift; if ($propMap->{Type} eq $PropertyMapTypes{ToColumn}) { $self->createPropColumnMap($classTableMap, $propMap, $columnType); } elsif ($propMap->{Type} eq $PropertyMapTypes{ToPropertyTable}) { my $propTableRef = $self->createPropTableMap($classTableMap, $propMap); $self->createPropColumnMap($propTableRef, $propMap, $columnType); } else { croak "Unknown Property map type: $propMap->{Type}"; } } sub processRelatedClassMap { my $self = shift; my $relatedMap = shift; my $classTableMap = shift; my $type = $relatedMap->{ClassMap}{Type}; if ($type = $ClassMapTypes{ToClassTable} or $type = $ClassMapTypes{ToRootTable}) { my $relatedTableMap = $self->getTableMap($relatedMap->{ClassMap}{Table}); push @{$classTableMap->{RelatedTables}}, $relatedTableMap; push @{$classTableMap->{ParentKeyIsCandidate}}, $relatedMap->{LinkInfo}{ParentKeyIsCandidate}; push @{$classTableMap->{ParentKeys}}, $relatedMap->{LinkInfo}{ParentKey}; push @{$classTableMap->{ChildKeys}}, $relatedMap->{LinkInfo}{ChildKey}; push @{$classTableMap->{OrderColumns}}, $relatedMap->{OrderInfo}{OrderColumn}; push @{$classTableMap->{Filter}}, $relatedMap->{Filter}; } elsif ($type = $ClassMapTypes{IgnoreRoot}) { croak "The element type $relatedMap->{ClassMap}{Name} was mapped as an ignored root, but listed as a related class."; } elsif ($type = $ClassMapTypes{Passthrough}) { croak "Class mapped as pass-through: $relatedMap->{ClassMap}{Name}"; } } sub processRootClassMaps { my $self = shift; foreach my $name (keys %{$self->{RootClassMaps}}) { my $rootClassMap = $self->{RootClassMaps}{$name}; #print "Processing root class map $name with type $rootClassMap->{ClassMap}{Type}\n"; if ($rootClassMap->{ClassMap}{Type} == $ClassMapTypes{ToRootTable}) { $self->processRootTableClassMap($rootClassMap); } elsif ($rootClassMap->{ClassMap}{Type} == $ClassMapTypes{IgnoreRoot}) { $self->processIgnoreRootClassMap($rootClassMap); } else { croak "Root classes must be mapped to root tables or ignored: $rootClassMap->{ClassMap}{Name}"; } } } sub processRootTableClassMap { my $self = shift; my $rootClassMap = shift; my $tableMap = $self->{TableMaps}{$rootClassMap->{ClassMap}{Table}}; croak "Surprise! Root element map points to non-existent table: $rootClassMap->{ClassMap}{Name}" if (!defined $tableMap); my $rootTableMap = $self->addRootTableMap($rootClassMap->{ClassMap}{Table}); $rootTableMap->{TableMap} = $tableMap; #print "Table map type $tableMap->{Type} mapped to the table $rootClassMap->{ClassMap}{Table}{Name}\n"; croak "Root table must be mapped as $TableMapTypes{ClassTable}" if ($tableMap->{Type} != $TableMapTypes{ClassTable}); $rootTableMap->{CandidateKey} = $rootClassMap->{LinkInfo}{ChildKey} if (defined $rootClassMap->{LinkInfo}); $rootTableMap->{OrderColumn} = $rootClassMap->{OrderInfo}{OrderColumn}; $rootTableMap->{Filter} = $rootClassMap->{Filter}; } sub processIgnoreRootClassMap { my $self = shift; my $rootClassMap= shift; my $subElementTypeMaps = $rootClassMap->{ClassMap}{SubElementTypeMaps}; foreach my $name (keys %{$subElementTypeMaps}) { my $tempMap = $subElementTypeMaps->{$name}; if (ref($tempMap) eq "XML::XMLtoDBMS::RelatedClassMap") { my $relatedMap = $tempMap; my $rootTableMap = $self->addRootTableMap($relatedMap->{ClassMap}{Table}); $rootTableMap->{TableMap} = $self->{TableMaps}{$relatedMap->{ClassMap}{Table}}; #print "Table map $name of type $rootTableMap->{TableMap}{Type}\n"; croak "Root table must be mapped as $TableMapTypes{ClassTable}" if ($rootTableMap->{TableMap}{Type} != $TableMapTypes{ClassTable}); $rootTableMap->{CandidateKey} = $relatedMap->{LinkInfo}{ChildKey} if (defined $relatedMap->{LinkInfo}); $rootTableMap->{OrderColumn} = $relatedMap->{OrderInfo}{OrderColumn}; $rootTableMap->{IgnoredRootType} = $rootClassMap->{ClassMap}{Name}; #$rootTableMap->{prefixedIgnoredRootType} = $rootClassMap->{ClassMap}{Name}; $rootTableMap->{Filter} = $relatedMap->{Filter}; } else { croak "The ignored root element type $rootClassMap->{ClassMap}{Name} has a child element type that is mapped as a property."; } } } sub addRootTableMap { my $self = shift; my $table = shift; croak "Table mapped as a root table more than once: $table->{Name}" if (exists ($self->{RootTableMaps}{$table})); my $rootTableMap = new XML::XMLtoDBMS::RootTableMap; $self->{RootTableMaps}{$table} = $rootTableMap; return $rootTableMap; } sub addClassTableMap { my $self = shift; my $classMap = shift; my $tableMap = $self->addTableMap($classMap->{Table}); $tableMap->{Type} = $TableMapTypes{ClassTable}; $tableMap->{ElementType} = $classMap->{Name}; $tableMap->{Level} = $classMap->{Level}; #$tableMap->{PrefixedElementType} = $classMap->{Name}; return $tableMap; } sub addPropertyTable { my $self = shift; my $tableName = shift; croak "The table $tableName is used as both a property table and a class table." if exists($self->{ClassTablesByName}{$tableName}); croak "More than one property is mapped to the table $tableName" if exists($self->{PropertyTables}{$tableName}); my $table = new XML::XMLtoDBMS::Table( Name => $tableName); $self->{PropertyTables}{$tableName} = $table; return $table; } sub addPropertyTableMap { my $self = shift; my $propMap = shift; my $tableMap = $self->addTableMap($propMap->{Table}); $tableMap->{Type} = $TableMapTypes{PropertyTable}; return $tableMap; } sub addTableMap { my $self = shift; my $table = shift; croak "More than one class or property mapped to the table $table->{Name}" if exists($self->{MappedTables}{$table}); $self->{MappedTables}{$table} = 1; return $self->getTableMap($table); } sub getTableMap { my $self = shift; my $table = shift; my $tableMap = $self->{TableMaps}{$table}; if (!defined $tableMap) { $tableMap = new XML::XMLtoDBMS::TableMap(Table => $table); $self->{TableMaps}{$table} = $tableMap; } return $tableMap; } sub createPropTableMap { my $self = shift; my $parentTableMap = shift; my $propMap = shift; my $propTableMap = $self->addPropertyTableMap($propMap); push @{$parentTableMap->{RelatedTables}}, $propTableMap; $parentTableMap->{ParentKeyIsCandidate} = $propMap->{LinkInfo}{ParentKeyIsCandidate}; push @{$parentTableMap->{ParentKeys}}, $propMap->{LinkInfo}{ParentKey}; push @{$parentTableMap->{ChildKeys}}, $propMap->{LinkInfo}{ChildKey}; push @{$parentTableMap->{OrderColumns}}, $propMap->{OrderInfo}{OrderColumn}; #now reference to an array push @{$parentTableMap->{Filter}}, $propMap->{Filter}; return $propTableMap; } sub createPropColumnMap { my $self = shift; my $tableMap = shift; my $propMap = shift; my $columnType = shift; my $columnMap; if ($columnType == $ColumnMapTypes{ToElementType}) { $columnMap = $tableMap->addElementTypeColumnMap($propMap->{Column}); } else { $columnMap = $tableMap->addPropertyColumnMap($propMap->{Column}); } $columnMap->{Type} = $columnType; $columnMap->{Property} = $propMap->{Name}; $columnMap->{MultiValued} = $propMap->{MultiValued}; $columnMap->{OrderColumn} = $propMap->{OrderInfo}{OrderColumn}; } sub createMapFromTemp { my $self = shift; $self->convertMap; return $self; } sub convertMap { my $self = shift; $self->convertTables; $self->convertTableMaps; $self->convertClassMaps; } sub convertTables { my $self = shift; $self->{Tables} = []; #print "Converting tables...\n"; foreach (keys %{$self->{ClassTablesByName}}) { #push @{$self->{Tables}}, $self->{ClassTablesByName}{$_}; $self->convertTable($self->{ClassTablesByName}{$_}) } delete $self->{ClassTablesByName}; foreach (keys %{$self->{PropertyTables}}) { #push @{$self->{Tables}}, $self->{PropertyTables}{$_}; $self->convertTable($self->{PropertyTables}{$_}) } delete $self->{PropertyTables}; } sub convertTable { my $self = shift; my $table = shift; my @columns; my $ind = 1; foreach (keys %{$table->{Columns}}) { push @columns, new XML::XMLtoDBMS::Column(Name => $_, Number => $ind++); } delete $table->{Columns}; push @{$self->{Tables}}, new XML::XMLtoDBMS::Table(Name => $table->{Name}, Number => $#{$self->{Tables}} + 1, Columns => \@columns); } sub convertTableMaps { my $self = shift; $self->buildTableInfos; $self->convertTableMaps1; #$self->convertTableMaps2; $self->convertRootTableMaps; } sub convertClassMaps { my $self = shift; foreach (keys %{$self->{ClassMaps}}) { $self->convertClassMap($self->{ClassMaps}{$_}); } $self->convertRootClassMaps; $self->{ClassMaps} = $self->{NewClassMaps}; } sub convertClassMap { my $self = shift; my $tempClassMap = shift; my $classMap = $self->getNewClassMap($tempClassMap->{Name}); $classMap->{Name} = $tempClassMap->{Name}; $classMap->{Type} = $tempClassMap->{Type}; $classMap->{Level} = $tempClassMap->{Level}; #print "Converting Map $tempClassMap->{Name}\n"; if ($tempClassMap->{Type} != $ClassMapTypes{IgnoreRoot}) { my $tableInfo = $self->{TableInfos}{$tempClassMap->{Table}{Name}}; $classMap->{Table} = $tableInfo->{Table}; $self->convertSubMaps( $classMap->{AttributeMaps}, $tempClassMap->{AttributeMaps}, $tableInfo ); $classMap->{PCDataMap} = $self->convertPropertyMap($tempClassMap->{PCDataMap}, $tableInfo) if defined $tempClassMap->{PCDataMap}; $self->convertSubMaps( $classMap->{SubElementTypeMaps}, $tempClassMap->{SubElementTypeMaps}, $tableInfo ); } else { $self->convertSubMaps( $classMap->{SubElementTypeMaps}, $tempClassMap->{SubElementTypeMaps}, undef ); } $tempClassMap = $classMap; } sub convertSubMaps { my ($self, $dest, $src, $parentTableInfo) = @_; #This method converts hashtables containing maps subordinate to the #class map. These hashtables can contain either property maps only #the hashtable maps for attributes) or a mixture of property maps and #related class maps (the hashtable for subelement types). foreach (keys %{$src}) { my $tempMap = $src->{$_}; if (ref($tempMap) eq 'XML::XMLtoDBMS::PropertyMap') { #print "Converting Property $tempMap->{Name}\n"; my $tempPropMap = $tempMap; my $propMap = $self->convertPropertyMap($tempPropMap, $parentTableInfo); $dest->{$tempPropMap->{Name}} = $propMap; } elsif (ref($tempMap) eq 'XML::XMLtoDBMS::RelatedClassMap') { #print "Converting RelatedClass $tempMap->{ClassMap}{Name}\n"; my $tempRelatedClassMap = $tempMap; my $relatedClassMap = $self->convertRelatedClassMap($tempRelatedClassMap, $parentTableInfo); $dest->{$tempRelatedClassMap->{ClassMap}{Name}} = $relatedClassMap; } else { croak "Unknown type of map: should be PropertyMap or RelatedClassMap)"; } } } sub convertPropertyMap { my ($self, $tempPropMap, $parentTableInfo) = @_; my $propMap = new XML::XMLtoDBMS::PropertyMap(Type => $tempPropMap->{Type}, MultiValued =>$tempPropMap->{MultiValued}); $propMap->{Name} = $tempPropMap->{Name} if (defined $tempPropMap->{Name}); if (defined $tempPropMap->{Table}) { #If the property is mapped to a table, get the TableInfo for that #table and set the table, column, link, and order information. Note #that the column occurs in the property table, not the parent table #and that the order column occurs in the table with the child key. my $propTableInfo = $self->{TableInfos}{$tempPropMap->{Name}}; $propMap->{Table} = $propTableInfo->{Table}; $propMap->{Column} = $propTableInfo->{Columns}{$tempPropMap->{Name}}; $propMap->{LinkInfo} = $self->convertLinkInfo($tempPropMap->{LinkInfo}, $parentTableInfo, $propTableInfo); if ($propMap->{LinkInfo}{ParentKeyIsCandidate}) { $propMap->{OrderInfo} = $self->convertOrderInfo($tempPropMap->{OrderInfo}, $propTableInfo); } else { $propMap->{OrderInfo} = $self->convertOrderInfo($tempPropMap->{OrderInfo}, $parentTableInfo); } } else { #If the property is mapped to a column, set the column and order #information. Note that these occur in the parent table. $propMap->{Column} = $parentTableInfo->{Columns}{$tempPropMap->{Column}}; $propMap->{OrderInfo} = $self->convertOrderInfo($tempPropMap->{OrderInfo}, $parentTableInfo); } return $propMap; } sub convertRelatedClassMap { my ($self, $tempRelatedMap, $parentTableInfo) = @_; #Create a new RelatedClassMap and set the ClassMap. Note that #getClassMap() might create the map. my $orderInfo; my $classMap = $self->getNewClassMap($tempRelatedMap->{ClassMap}{Name}); my $relatedInfo = $self->{TableInfos}{$tempRelatedMap->{ClassMap}{Table}{Name}}; my $linkInfo = $self->convertLinkInfo($tempRelatedMap->{LinkInfo}, $parentTableInfo, $relatedInfo); if ($tempRelatedMap->{LinkInfo}{ParentKeyIsCandidate}) { $orderInfo = $self->convertOrderInfo($tempRelatedMap->{OrderInfo}, $relatedInfo); } else { $orderInfo = $self->convertOrderInfo($tempRelatedMap->{OrderInfo}, $parentTableInfo); } return new XML::XMLtoDBMS::RelatedClassMap(ClassMap => $classMap, LinkInfo => $linkInfo, OrderInfo => $orderInfo, Filter => $tempRelatedMap->{Filter}); } sub convertLinkInfo { my ($self, $tempLinkInfo, $parentInfo, $childInfo) = @_; my ($parentKey, $childKey) = ([], []); $self->convertKeyColumns($parentKey, $tempLinkInfo->{ParentKey}, $parentInfo->{Columns}) if exists($tempLinkInfo->{ParentKey}); $self->convertKeyColumns($childKey, $tempLinkInfo->{ChildKey}, $childInfo->{Columns}); return {GenerateKey => $tempLinkInfo->{GenerateKey}, ParentKeyIsCandidate => $tempLinkInfo->{ParentKeyIsCandidate}, ParentKey => $parentKey, ChildKey => $childKey}; } sub convertOrderInfo { my ($self, $tempOrderInfo, $tableInfo); return undef if !defined $tempOrderInfo; return { GenerateOrder => $tempOrderInfo->{GenerateOrder}, OrderColumn => (defined $tempOrderInfo->{OrderColumn}) ? $tableInfo->{Columns}{$tempOrderInfo->{OrderColumn}} : undef, Direction => $tempOrderInfo->{Direction} }; } sub convertRootClassMaps { my $self = shift; foreach (keys %{$self->{RootClassMaps}}) { my $tempRootClassMap = $self->{RootClassMaps}{$_}; my $rootClassMap = $self->convertRootClassMap($tempRootClassMap); #now lets delete the old RootClassMap reference even though #it might have the same key=$name since we use the same RootClassMaps array my $name = $tempRootClassMap->{ClassMap}{Name}; delete $self->{RootClassMaps}{$_}; $self->{RootClassMaps}{$name} = $rootClassMap; } } sub convertRootClassMap { my $self = shift; my $tempRootMap = shift; my $rootMap = new XML::XMLtoDBMS::RootClassMap; $rootMap->{ClassMap} = $self->getNewClassMap($tempRootMap->{ClassMap}{Name}); #Convert the link info and order info. Note that link info can only #be null in the case where the root element type is mapped as #IGNOREROOT. In this case, the order info is always null. if (defined $tempRootMap->{LinkInfo}) { #Get the TableInfo for the related class' table. my $rootInfo = $self->{TableInfos}{$tempRootMap->{ClassMap}{Table}{Name}}; #Convert the link and order info. Note that the order column is #always in the "child" (root) table, regardless of the value of #parentKeyIsCandidate. This is because there is no parent table. $rootMap->{LinkInfo} = $self->convertLinkInfo($tempRootMap->{LinkInfo}, undef, $rootInfo); $rootMap->{OrderInfo} = $self->convertOrderInfo($tempRootMap->{OrderInfo}, $rootInfo); } $rootMap->{Filter} = $tempRootMap->{Filter}; return $rootMap; } sub buildTableInfos { my $self = shift; #print "Building TableInfo structures...\n"; foreach (@{$self->{Tables}}) { #print "Table $_->{Name} has columns "; my $columns = {}; foreach (@{$_->{Columns}}) { $columns->{$_->{Name}} = $_; #print "$_->{Name} "; } #print "\n"; $self->{TableInfos}{$_->{Name}} = {Table => $_, Columns => $columns}; } } sub convertTableMaps1 { my $self = shift; my @tableMaps; foreach (keys %{$self->{TableMaps}}) { my $tableMap = $self->{TableMaps}{$_}; #print "Converting table for table $tableMap->{Table}{Name}\n"; my $tableInfo = $self->{TableInfos}{$tableMap->{Table}{Name}}; my $columnMaps = []; $self->processColumnMaps($tableMap->{ElementTypeColumnMaps}, $columnMaps, $tableInfo->{Columns}); $self->processColumnMaps($tableMap->{PropertyColumnMaps}, $columnMaps, $tableInfo->{Columns}); my $newTableMap = new XML::XMLtoDBMS::TableMap(Table => $tableInfo->{Table}, Type => $tableMap->{Type}, Level => $tableMap->{Level}, ElementType => $tableMap->{ElementType}, ColumnMaps => $columnMaps, RelatedTables => [], Filter => $tableMap->{Filter}); $tableMaps[$tableInfo->{Table}{Number}] = $newTableMap; } ############ assign @tableMaps to {TableMaps} before exiting this function foreach (keys %{$self->{TableMaps}}) { my $tableMap = $self->{TableMaps}{$_}; my $tableInfo = $self->{TableInfos}{$tableMap->{Table}{Name}}; my $newTableMap = $tableMaps[$tableInfo->{Table}{Number}]; for (my $i = 0; $i < $#{$tableMap->{RelatedTables}} + 1; $i++) { my $relatedTable = $tableMap->{RelatedTables}[$i]; my $relatedInfo = $self->{TableInfos}{$relatedTable->{Table}{Name}}; push @{$newTableMap->{RelatedTables}}, $tableMaps[$relatedInfo->{Table}{Number}]; push @{$newTableMap->{ParentKeyIsCandidate}}, $tableMap->{ParentKeyIsCandidate}[$i]; #print "Table $tableMap->{Table}{Name} has related table $relatedTable->{Table}{Name}\n"; #print "$tableMap->{ParentKeyIsCandidate}[$i]\n"; $newTableMap->{ParentKeys}[$i] = []; $newTableMap->{ChildKeys}[$i] = []; $self->convertKeyColumns($newTableMap->{ParentKeys}[$i], $tableMap->{ParentKeys}[$i], $tableInfo->{Columns}); $self->convertKeyColumns($newTableMap->{ChildKeys}[$i], $tableMap->{ChildKeys}[$i], $relatedInfo->{Columns}); if (!defined $relatedTable->{OrderColumn}[$i]) { push @{$newTableMap->{OrderColumn}}, undef; } elsif ($relatedTable->{ParentKeyIsCandidate}[$i]) { push @{$newTableMap->{OrderColumn}}, $relatedInfo->{Columns}{$tableMap->{OrderColumn}[$i]}; ### smth to be done here } else { push @{$newTableMap->{OrderColumn}}, $tableInfo->{Columns}{$tableMap->{OrderColumn}[$i]}; } } } delete $self->{TableMaps}; $self->{TableMaps} = \@tableMaps; } sub convertKeyColumns { my ($self, $keyColumns, $tempColumns, $columns) = @_; #print "Related columns are: "; foreach (@{$tempColumns}) { #print "$_ "; push @{$keyColumns}, $columns->{$_}; } #print "\n"; } sub processColumnMaps { my $self = shift; my $columnMaps = shift; my $newColumnMaps = shift; my $columns = shift; my $orderColumn; foreach (values %{$columnMaps}) { $orderColumn = (!defined $columnMaps->{OrderColumn})? undef : $columns->{$_->{OrderColumn}}; push @{$newColumnMaps}, new XML::XMLtoDBMS::ColumnMap( Type => $_->{Type}, Column => $columns->{$_->{Column}}, OrderColumn => $orderColumn, Property => $_->{Property}, MultiValued => $_->{MultiValued}); } } sub convertRootTableMaps { my $self = shift; my $rootTableMaps = {}; my $candidateKey = []; foreach (keys %{$self->{RootTableMaps}}) { my $rootTableMap = $self->{RootTableMaps}{$_}; #print "Creating rootmap that maps to table $rootTableMap->{TableMap}{Table}{Name}\n"; my $tableName = $rootTableMap->{TableMap}{Table}{Name}; my $tableInfo = $self->{TableInfos}{$tableName}; $self->convertKeyColumns($candidateKey, $rootTableMap->{CandidateKey}, $tableInfo->{Columns}); my $orderColumn; $orderColumn = $tableInfo->{Columns}{$rootTableMap->{OrderColumn}} if defined $rootTableMap->{OrderColumn}; $rootTableMaps->{$tableName} = new XML::XMLtoDBMS::RootTableMap( TableMap => $self->{TableMaps}[$tableInfo->{Table}{Number}], IgnoredRootType => $rootTableMap->{IgnoredRootType}, CandidateKey => $candidateKey, OrderColumn => $orderColumn, OrderDirection => $rootTableMap->{OrderDirection}, Filter => $rootTableMap->{Filter} ); } delete $self->{RootTableMaps}; $self->{RootTableMaps} = $rootTableMaps; } sub checkOutSelectStmt { my ($self, $table, $whereColumns, $orderbyColumn, $filter, $keysonly) = @_; my $stmt; croak "Connection not set." if !defined $self->{DB}; my $selectString = $self->buildSelectString($table, $whereColumns, $orderbyColumn, $filter, $keysonly); $stmt = $self->{DB}->prepare($selectString); print "$selectString\n" if !defined $stmt; return $stmt; } sub checkOutSelectStmtByTable { my ($self, $tableNum, $subTableNum) = @_; my $stmt; croak "Connection not set." if !defined $self->{DB}; #If the select strings have not yet been built, build them now. $self->buildSelectStrings if !defined $self->{SelectStrings}; return pop @{$self->{SelectStacks}[$tableNum][$subTableNum]} if scalar @{$self->{SelectStacks}[$tableNum][$subTableNum]}; #Since no prepared statement is available, try to create a new one. If #this fails, assumes that the reason is a limit on the number of #prepared statements, close an existing (unused) statement, and try #again. If this fails, or if there are no unused statements to close, #throw an error. $stmt = $self->{DB}->prepare($self->{SelectStrings}[$tableNum][$subTableNum]); print $self->{SelectStrings}[$tableNum][$subTableNum] . "\n" if (!defined $stmt); return $stmt; } sub buildSelectStrings { my $self = shift; my $i = 0; $self->{SelectStrings} = []; $self->{SelectStacks} = []; foreach my $tableMap (@{$self->{TableMaps}}) { my $j = 0; foreach (@{$tableMap->{RelatedTables}}) { push @{$self->{SelectStrings}[$i]}, $self->buildSelectStringForRelatedTable($tableMap, $j++); push @{$self->{SelectStacks}[$i]}, []; } $i++; } } sub buildSelectStringForRelatedTable { my $self = shift; my $tableMap = shift; my $relatedTable = shift; 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." if (defined $tableMap->{OrderColumns}[$relatedTable] and !$tableMap->{ParentKeyIsCandidate}); #BUG!!! The order column stuff doesn't work when the parent key is #a foreign key. In fact, the entire Row object falls apart. The #problem is that in this case, the order column is in the parent table, #which thus needs to be joined to the child table, which means that the #result set is no longer shaped like a single table -- the assumption #on which Row (and probably a lot of other code) is built. return $self->buildSelectString($tableMap->{RelatedTables}[$relatedTable]{Table}, $tableMap->{ChildKeys}[$relatedTable], $tableMap->{OrderColumns}[$relatedTable], $tableMap->{Filter}[$relatedTable]); } sub buildSelectString { my ($self, $table, $whereColumns, $orderbyColumn, $filter, $keysonly) = @_; my $selectString = "SELECT "; my $comma = ''; my @columns; my $includeOrderColumn; if (!defined $keysonly or $keysonly == 0) { @columns = @{$table->{Columns}}; } else { if (defined $orderbyColumn) { $includeOrderColumn = 1; foreach (@{$whereColumns}) { if ($orderbyColumn == $_) { $includeOrderColumn = 0; last; } } } else { $includeOrderColumn = 0; } if ($includeOrderColumn) { @columns = (@{$whereColumns}, $orderbyColumn); } else { @columns = @{$whereColumns}; } undef $whereColumns; } foreach(@columns) { $selectString .= $comma . $self->replaceParameters($_->{Name}); $comma = ', '; } $selectString .= " FROM $table->{Name}"; $filter = $self->replaceParameters($filter) if defined $filter; if (defined $whereColumns) { if ($whereColumns > 0) { $selectString .= " WHERE "; my $and = ''; foreach(@{$whereColumns}) { $selectString .= $and . $_->{Name} . " = ? "; #$selectString .= $and . "(" . $_->{Name} . " = ? "; #$selectString .= "OR (? IS NULL AND " . $_->{Name} . " IS NULL))"; $and = ' AND '; } $selectString .= " AND " . $filter if defined $filter; } else { $selectString .= " WHERE " . $filter if defined $filter; } } else { $selectString .= " WHERE " . $filter if defined $filter; } #Add ORDER BY clause. We sort in descending order because this #gives us better performance in some cases. For more details, #see DBMSToDOM.Order.insertChild, which really ought to be #rewritten to use a binary search. if (defined $orderbyColumn) { $selectString .= " ORDER BY $orderbyColumn->{Name}"; } #print $selectString . "\n"; return $selectString; } sub checkInSelectStmt { my ($self, $prepStmt, $tableNum, $subTableNum) = @_; croak "Connection not set." if !defined $self->{DB}; push @{$self->{SelectStacks}[$tableNum][$subTableNum]}, $prepStmt if (defined $tableNum); } sub checkOutInsertStmt { my $self = shift; my $table = shift; croak "Connection not set." if !defined $self->{DB}; $self->buildInsertStrings if !defined $self->{InsertStrings}; #checkMaxActiveStmts(); if (defined $self->{InsertStacks}[$table->{Number}][0]) #if array has elements { return pop @{$self->{InsertStacks}[$table->{Number}]}; } #print $self->{InsertStrings}[$table->{Number}] . "\n"; return $self->{DB}->prepare($self->{InsertStrings}[$table->{Number}]); } sub checkInInsertStmt { my $self = shift; my $preparedStmt = shift; my $table = shift; croak "Connection not set." if !defined $self->{DB}; push @{$self->{InsertStacks}[$table->{Number}]}, $preparedStmt; } sub buildInsertStrings { my $self = shift; $self->{InsertStrings} = []; $self->{InsertStacks} = []; foreach (@{$self->{Tables}}) { push @{$self->{InsertStrings}}, $self->buildInsertString($_); push @{$self->{InsertStacks}}, []; } } sub buildInsertString { my $self = shift; my $table = shift; my $istr = "INSERT INTO $table->{Name} ("; my $comma = ''; foreach(@{$table->{Columns}}) { $istr .= "$comma$_->{Name}"; $comma = ', '; } $istr .= ") VALUES ("; $comma = ''; foreach(@{$table->{Columns}}) { $istr .= "$comma?"; $comma = ', '; } $istr .= ")"; #print $istr . "\n"; return $istr; } sub replaceParameters { my ($self, $string) = @_; my ($key, $value); while (($key, $value) = each(%{$self->{Parameters}})) { $value = "" if not defined $value; $string =~ s/\$${key}/${value}/g ; } return $string; } ###################################################################### package XML::XMLtoDBMS::MapFactory; ###################################################################### #use strict; use Carp; use XML::Parser::PerlSAX; use vars qw(%States %ClassMapTypes %PropertyMapTypes %ColumnMapTypes); BEGIN { %States = (None => 0x00, ClassMap => 0x01, ToRootTable => 0x02, ToClassTable => 0x04, IgnoreRoot => 0x08, PropertyMap => 0x10, ToColumn => 0x20, ToPropertyTable => 0x40, CandidateKey => 0x80, ForeignKey => 0x100, RelatedClass => 0x200, PseudoRoot => 0x400, Root => 0x03, RootCandidate => 0x83, ClassTable => 0x05, Prop => 0x11, PropToColumn => 0x31, PropToTable => 0x51, PropCandidate => 0xD1, PropForeign => 0x151, Related => 0x201, RelatedCandidate => 0x281, RelatedForeign => 0x301, Pseudo => 0x408, PseudoCandidate => 0x488 ); %ClassMapTypes = ( ToRootTable => 1, ToClassTable => 2, IgnoreRoot => 3, PassThrough => 4); %PropertyMapTypes = (ToColumn => 1, ToPropertyTable => 2); } sub new { my $type = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; bless $self, $type; $self->initialize; return $self; } sub initialize { my $self = shift; $self->{State} = $States{None}; $self->{Map} = new XML::XMLtoDBMS::Map; } sub createMap { my $self = shift; my $file = shift; my $dbh = shift; my $parser = new XML::Parser::PerlSAX( Handler => $self ); $parser->parse(Source => {SystemId => $file}); #print "Parser finished\n"; $self->{Map}->{DB} = $dbh; $self->{Map}->createTableMapsFromClassMaps; return $self->{Map}->createMapFromTemp; } sub start_document { my $self = shift; $self->{lists} = []; $self->{cur_list} = []; } sub end_document { my $self = shift; $self->{Map}{Parameters}{DateFormat} = convertFormat($self->{DatePattern} ? $self->{DatePattern} : "YYYY-MM-DD"); $self->{Map}{Parameters}{TimeFormat} = convertFormat($self->{TimePattern} ? $self->{TimePattern} : "hh:mm:ss"); $self->{Map}{Parameters}{TimestampFormat} = convertFormat($self->{TimestampPattern} ? $self->{TimestampPattern} : "YYYY-MM-DDThh:mm:ssZ"); delete $self->{cur_list}; delete $self->{lists}; } sub start_element { my $self = shift; my $element = shift; my $contents = []; $element->{Contents} = $contents; my $sub = "$element->{Name}"; &$sub($self, $element->{Attributes}); #print "StateIN is $self->{State}\n"; push @{ $self->{lists} }, $self->{cur_list}; push @{ $self->{cur_list} }, $element; $self->{cur_list} = $contents; } sub end_element { my $self = shift; my $element = shift; my $sub = "$element->{Name}_"; &$sub($self, $element); #print "StateOut is $self->{State}\n"; $self->{cur_list} = pop @{ $self->{lists} }; } sub characters { my $self = shift; } sub ignorable_whitespace { my $self = shift; } sub processing_instruction { my $self = shift; } sub record_end { my $self = shift; } sub notation_decl { my $self = shift; #$self->{Map}{Notations}{$notation->{Name}} = $notation; } sub comment { my $self = shift; #push @{ $self->{cur_list} }, $comment; } sub appinfo { my $self = shift; my $appinfo = shift; $self->{Map}{AppInfo} = $appinfo->{AppInfo}; } sub conforming { my $self = shift; $self->{Map}{Conforming} = 1; } sub warning { my $self = shift; my $error = shift; push (@{ $self->{Map}{Errors} }, $error); } sub error { my $self = shift; my $error = shift; push (@{ $self->{Map}{Errors} }, $error); } sub fatal_error { my $self = shift; my $error = shift; push (@{ $self->{Map}{Errors} }, $error); } sub XMLToDBMS {} sub XMLToDBMS_ {} sub Options {} sub Options_ {} sub DateTimeFormats {} sub DateTimeFormats_ {} sub Patterns { my $self = shift; my $Attributes = shift; $self->{DatePattern} = $Attributes->{Date} if exists $Attributes->{Date}; $self->{TimePattern} = $Attributes->{Time} if exists $Attributes->{Time}; $self->{TimestampPattern} = $Attributes->{Timestamp} if exists $Attributes->{Timestamp}; } sub Patterns_ {} sub Maps {} sub Maps_ {} sub IgnoreRoot { my $self = shift; $self->{State} |= $States{IgnoreRoot}; } sub IgnoreRoot_ { my $self = shift; $self->{State} &= ~$States{IgnoreRoot}; } sub PseudoRoot { my $self = shift; $self->{RelatedMap} = new XML::XMLtoDBMS::RelatedClassMap; $self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate} = 0; $self->{State} |= $States{PseudoRoot}; } sub PseudoRoot_ { my $self = shift; $self->{State} &= ~$States{PseudoRoot}; } sub Table { my $self = shift; my $Attributes = shift; my $tableName = $Attributes->{Name}; #print "Table name $tableName\n"; if ($self->{State} == $States{Root} or $self->{State} == $States{ClassTable}) { $self->{ClassMap}{Table} = $self->{Map}->addClassTable($self->{ClassMap}{Name}, $tableName); } elsif ($self->{State} == $States{PropToTable}) { $self->{PropMap}{Table} = $self->{Map}->addPropertyTable($tableName); } } sub Table_ { } sub ClassMap { my $self = shift; #print "State before class $self->{State}\n"; $self->{State} |= $States{ClassMap}; } sub ClassMap_ { my $self = shift; $self->{State} &= ~$States{ClassMap}; #print "State after class $self->{State}\n"; } sub ElementType { my $self = shift; my $Attributes = shift; #print "ElementType $Attributes->{Name} while state is $self->{State}\n"; if ($self->{State} == $States{ClassMap}) { $self->{ClassMap} = $self->{Map}->addClassMap($Attributes->{Name}); $self->{ClassMap}{Level} = $Attributes->{Level}; } elsif ($self->{State} == $States{Prop}) { $self->{PropMap}{Name} = $Attributes->{Name}; $self->{ClassMap}->addElementPropertyMap($self->{PropMap}); } elsif ($self->{State} == $States{Related} or $self->{State} == $States{Pseudo}) { $self->{RelatedMap}{ClassMap} = $self->{Map}->getClassMap($Attributes->{Name}); $self->{ClassMap}->addRelatedClassMap($self->{RelatedMap}); } elsif ($self->{State} == $States{IgnoreRoot}) { $self->{ClassMap} = $self->{Map}->addClassMap($Attributes->{Name}); $self->{ClassMap}{Type} = $ClassMapTypes{IgnoreRoot}; $self->{RootClassMap} = $self->{Map}->addRootClassMap($self->{ClassMap}); } } sub ElementType_ { } sub ToClassTable { my $self = shift; $self->{ClassMap}{Type} = $ClassMapTypes{ToClassTable}; $self->{State} |= $States{ToClassTable}; } sub ToClassTable_ { my $self = shift; $self->{State} &= ~$States{ToClassTable}; } sub PropertyMap { my $self = shift; $self->{PropMap} = new XML::XMLtoDBMS::PropertyMap; $self->{State} |= $States{PropertyMap}; } sub PropertyMap_ { my $self = shift; $self->{State} &= ~$States{PropertyMap}; } sub Attribute { my $self = shift; my $Attributes = shift; $self->{PropMap}{Name} = $Attributes->{Name}; $self->{PropMap}{MultiValued} = ($Attributes->{Name} eq "Yes"); $self->{ClassMap}->addAttributePropertyMap($self->{PropMap}); } sub Attribute_ { } sub ToColumn { my $self = shift; $self->{PropMap}{Type} = $PropertyMapTypes{ToColumn}; $self->{State} |= $States{ToColumn}; } sub ToColumn_ { my $self = shift; $self->{State} &= ~$States{ToColumn}; } sub Column { my $self = shift; my $Attributes = shift; my $colname = $Attributes->{Name}; #print "Column name $colname while state is $self->{State}\n"; if ($self->{State} == $States{RootCandidate}) { $self->{ClassMap}{Table}->addColumn($colname); push @{$self->{RootClassMap}{LinkInfo}{ChildKey}}, $colname; } elsif ($self->{State} == $States{PropToColumn}) { $self->{ClassMap}{Table}->addColumnWithCheck($colname); $self->{PropMap}{Column} = $colname; } elsif ($self->{State} == $States{PropToTable}) { $self->{PropMap}{Table}->addColumnWithCheck($colname); $self->{PropMap}{Column} = $colname; } elsif ($self->{State} == $States{PropCandidate}) { if ($self->{PropMap}{LinkInfo}{ParentKeyIsCandidate}) { $self->{ClassMap}{Table}->addColumn($colname); push @{$self->{PropMap}{LinkInfo}{ParentKey}}, $colname; } else { $self->{PropMap}{Table}->addColumn($colname); push @{$self->{PropMap}{LinkInfo}{ChildKey}}, $colname; } } elsif ($self->{State} == $States{PropForeign}) { if ($self->{PropMap}{LinkInfo}{ParentKeyIsCandidate}) { $self->{PropMap}{Table}->addColumn($colname); push @{$self->{PropMap}{LinkInfo}{ChildKey}}, $colname; } else { $self->{ClassMap}{Table}->addColumn($colname); push @{$self->{PropMap}{LinkInfo}{ParentKey}}, $colname; } } elsif ($self->{State} == $States{RelatedCandidate} or $self->{State} == $States{PseudoCandidate}) { if ($self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate}) { $self->{ClassMap}{Table}->addColumn($colname); push @{$self->{RelatedMap}{LinkInfo}{ParentKey}}, $colname; } else { if (!defined $self->{RelatedMap}{ClassMap}{Table}) { $self->{RelatedMap}{ClassMap}{Table} = $self->{Map}->getClassTable($self->{RelatedMap}{ClassMap}{Name}); } $self->{RelatedMap}{ClassMap}{Table}->addColumn($colname); push @{$self->{RelatedMap}{LinkInfo}{ChildKey}}, $colname; } } elsif ($self->{State} == $States{RelatedForeign}) { if ($self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate}) { if (!defined $self->{RelatedMap}{ClassMap}{Table}) { $self->{RelatedMap}{ClassMap}{Table} = $self->{Map}->getClassTable($self->{RelatedMap}{ClassMap}{Name}); } $self->{RelatedMap}{ClassMap}{Table}->addColumn($colname); push @{$self->{RelatedMap}{LinkInfo}{ChildKey}}, $colname; } else { $self->{ClassMap}{Table}->addColumn($colname); push @{$self->{RelatedMap}{LinkInfo}{ParentKey}}, $colname; } } } sub Column_ { } sub EmptyStringIsNull { my $self = shift; $self->{Map}{EmptyStringIsNull} = 1; } sub EmptyStringIsNull_ { } sub CandidateKey { my $self = shift; my $Attributes = shift; my $genkey = 0; $genkey = ($Attributes->{Generate} eq "Yes") if (defined $Attributes->{Generate}); $self->{Map}{Generate} = $genkey; my $state = $self->{State}; if ($state == $States{Root}) { $self->{RootClassMap}{LinkInfo}{GenerateKey} = $genkey; } if ($state == $States{PropToTable}) { $self->{PropMap}{LinkInfo}{GenerateKey} = $genkey; } if ($state == $States{Related} or $state == $States{Pseudo}) { $self->{RelatedMap}{LinkInfo}{GenerateKey} = $genkey; } $self->{State} |= $States{CandidateKey}; } sub CandidateKey_ { my $self = shift; $self->{State} &= ~$States{CandidateKey}; } sub ForeignKey { my $self = shift; $self->{State} |= $States{ForeignKey}; } sub ForeignKey_ { my $self = shift; $self->{State} &= ~$States{ForeignKey}; } sub RelatedClass { my $self = shift; my $Attributes = shift; $self->{RelatedMap} = new XML::XMLtoDBMS::RelatedClassMap; #my $type = ref($self->{RelatedMap}); $self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate} = ($Attributes->{KeyInParentTable} eq "Candidate"); $self->{State} |= $States{RelatedClass}; } sub ToRootTable { my $self = shift; $self->{RootClassMap} = $self->{Map}->addRootClassMap($self->{ClassMap}); $self->{RootClassMap}{LinkInfo} = {ParentKeyIsCandidate => 0}; $self->{ClassMap}{Type} = $ClassMapTypes{ToRootTable}; $self->{State} |= $States{ToRootTable} } sub ToRootTable_ { my $self = shift; $self->{State} &= ~$States{ToRootTable} } sub RelatedClass_ { my $self = shift; $self->{State} &= ~$States{RelatedClass}; } sub PCDATA { my $self = shift; croak "PCDtata for $self->{ClassMap}{Name} mapped more then once" if defined $self->{ClassMap}{PCDataMap}; $self->{ClassMap}{PCDataMap} = $self->{PropMap}; $self->{PropMap}{Name} = ''; } sub PCDATA_ { } sub OrderColumn { my $self = shift; my $Attributes = shift; my $colname = $Attributes->{Name}; my $direction = $Attributes->{Direction}; my $generate = 0; $generate = ($Attributes->{Generate} eq "Yes") if defined $Attributes->{Generate}; my $state = $self->{State}; if ($state == $States{Root}) { $self->{RootClassMap}{ClassMap}{Table}->addColumn($colname); $self->{RootClassMap}{OrderInfo} = { OrderColumn => $colname, GenerateOrder => $generate, Direction => $direction }; } elsif ($state == $States{Prop}) { if ($self->{PropMap}{Type} = $PropertyMapTypes{ToColumn}) { #Order column is parallel to the property column in the #class table. $self->{ClassMap}{Table}->addColumn($colname); } elsif ($self->{PropMap}{Type} = $PropertyMapTypes{ToTabl}) { #Order column is in table of foreign key. if ($self->{PropMap}{LinkInfo}{ParentKeyIsCandidate}) { $self->{PropMap}{Table}->addColumn($colname); } else { $self->{ClassMap}{Table}->addColumn($colname); } } else { croak "Unknown property map type"; } $self->{PropMap}{OrderInfo} = { OrderColumn => $colname, GenerateOrder => $generate, Direction => $direction }; } elsif ($state == $States{Related} or $state == $States{Pseudo}) { #Order column is in table of foreign key. if ($self->{RelatedMap}{LinkInfo}{ParentKeyIsCandidate} or $state == $States{Pseudo}) { if (!defined $self->{RelatedMap}{ClassMap}{Table}) { $self->{RelatedMap}{ClassMap}{Table} = $self->{Map}{Name}; } $self->{RelatedMap}{ClassMap}{Table}->addColumn($colname); } else { $self->{ClassMap}{Table}->addColumn($colname); } $self->{RelatedMap}{OrderInfo} = { OrderColumn => $colname, GenerateOrder => $generate, Direction => $direction }; } } sub OrderColumn_ { } sub ToPropertyTable { my $self = shift; my $Attributes = shift; $self->{PropMap}{Type} = $PropertyMapTypes{ToPropertyTable}; $self->{PropMap}{LinkInfo}{ParentKeyIsCandidate} = ($Attributes->{KeyInParentTable} eq 'Candidate'); $self->{State} |= $States{ToPropertyTable}; } sub ToPropertyTable_ { my $self = shift; $self->{State} &= ~$States{ToPropertyTable}; } sub Parameter { my $self = shift; my $Attributes = shift; $self->{Map}{Parameters}{$Attributes->{Name}} = undef; #print $Attributes->{Name} . "\n"; } sub Parameter_ { } sub Filter { my $self = shift; my $Attributes = shift; my $filter = $Attributes->{Value}; my $state = $self->{State}; if ($state == $States{Root}) { $self->{RootClassMap}{Filter} = $filter; } if ($state == $States{PropToTable}) { $self->{PropMap}{Filter} = $filter; } if ($state == $States{Related} or $state == $States{Pseudo}) { $self->{RelatedMap}{Filter} = $filter; } # no need to change state umless there will be sublevels to this. #$self->{State} |= $States{Filter}; } sub Filter_ { } sub convertFormat { my $formatString = shift; $formatString =~ s/YYYY/%Y/g; $formatString =~ s/YY/%y/g; $formatString =~ s/MM/%m/g; $formatString =~ s/DD/%d/g; $formatString =~ s/hh/%H/g; $formatString =~ s/mm/%M/g; $formatString =~ s/ss/%S/g; return $formatString; }