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    '<' => '&lt;',
75    '>' => '&gt;',
76    '"' => '&quot;',
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