The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
###
#
# $Id: pop_tables.pl,v 1.8 2001/07/28 00:03:39 trostler Exp $
#
# COPYRIGHT AND LICENSE
# Copyright (c) 2001, Juniper Networks, Inc.  
# All rights reserved.
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
# 	1.	Redistributions of source code must retain the above
# copyright notice, this list of conditions and the following
# disclaimer. 
# 	2.	Redistributions in binary form must reproduce the above
# copyright notice, this list of conditions and the following disclaimer
# in the documentation and/or other materials provided with the
# distribution. 
# 	3.	The name of the copyright owner may not be used to 
# endorse or promote products derived from this software without specific 
# prior written permission. 
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
###

###
#
# Pull XML data out of file & put into RDB tables created by make_tables.pl
# 
####
use strict;
use XML::DOM;
use DBIx::Recordset;
use DBIx::Sequence;

# Grab common routines
use common;

# Read/parse XML
my $doc = new XML::DOM::Parser->parsefile(shift);
my $head = $doc->getDocumentElement;

# Set up sequence
my $sequence = new DBIx::Sequence({db_dsn => DSN});

# Set up DBIx::Recordset - it doesn't like MySQL
$DBIx::Recordset::FetchsizeWarn = 0;

# Get 1:N relationships
my $one_to_n = &get_one_to_n_db(DSN);

# Get to work!
my $root_pk = &populate_table($head);

# Tell them what they've won...
my $root_table_name = &mtn($head->getNodeName);
print "\n\tTo re-create this data back into XML use:\n";
print "\t% perl unpop_tables.pl $root_table_name $root_pk\n\n";
print "\tIf this is an XML Schema and you want fully-specified XML back use:\n";
print "\t% perl unpop_schema.pl $root_pk\n\n";

# 
# The recursive work-horse - pulls out XML data & puts into RDB
#
# So the strategy here is to build up a 'values' hash who's keys
#   are column names & values are column values.  Plain text columns
#   are what they are - 1:1 relationship columns are recursively 
#   determined and 1:N columns are recursively filled out & then stored
#   and then output once this table is completely filled - since we
#   can't fill out the 'N' tables until we know this table's primary key value,
#   which we don't know until we insert it & it gets generated!
#
sub populate_table {
    my($head) = @_;
    my(%values,%set_our_pk_in_table);
    use vars qw(*insert);   # DBIx::Recordset deals with GLOBs

    # Get this element's name
    my $name = $head->getNodeName;

    # Get 'real' Database names for this element
    my $db_table_name = &mtn($name);

    # Check for attributes - easy plain text columns
    if (my $attributes = $head->getAttributes) {
        for(my $i = 0 ; $i < $attributes->getLength ; $i++) {
            my $attr = $attributes->item($i);
            my $name = &normalize($attr->getName);
            my $value = $attr->getValue;
            $values{"${db_table_name}_${name}_attribute"} = $value;
        }
    }

    # Now created each sub-element of this element
    foreach my $sub_table ($head->getChildNodes) {
        my($db_st_name) = &normalize($sub_table->getNodeName);

        # Text node - just a '_value' in this table
        if ($sub_table->getNodeType == XML::DOM::TEXT_NODE) {
            next if (!defined $sub_table->getNodeValue || 
                        $sub_table->getNodeValue =~ /^\s*$/);
            $values{"${db_table_name}_value"} = $sub_table->getNodeValue;
            next;
        }

        #
        # Note this 'if' statement is EXACTLY the same one as in make_tables.pl
        #   used to determine what's a text element & what isn't - otherwise
        #   carnage would ensue
        #
        if (($sub_table->getAttributes && !$sub_table->getAttributes->getLength) && (!$sub_table->getChildNodes || ($#{$sub_table->getChildNodes} == 1 && $sub_table->getChildNodes->[0]->getNodeType == XML::DOM::TEXT_NODE))) {
            # This subtable's value is in this table for one various
            #   reason or another...

            my($val,$parent);
            if ($sub_table->hasChildNodes) {
                # if this guy has child nodes & it's in this table it
                #   must be 'cuz it only has one child node & it's
                #   a TEXT node
                $val = $sub_table->getChildNodes->[0]->getNodeValue || 'null';
            }
            else {
                # This sub table don't got no child nodes so we're
                #   only interested in if this tag is there or not
                #   & since we're here it must be here!
                $val = 'present';
            }

            # Now figure out what the name of this field is
            $parent = &normalize($sub_table->getNodeName);

            # We've hit bottom!
            $values{"${db_table_name}_${parent}_value"} = $val;
        }
        else {
            # At this point we're dealing with either a 1:1 or 1:N relationship

            # XML comments also fall to here - maybe one day we'll keep 'em
            next if ($sub_table->getNodeName eq '#comment');

            # Get PK of sub table
            my $sub_table_index = populate_table($sub_table);
   
            # Check our handy-dandy one_to_n data structure
            if ($one_to_n->{&mtn($head->getNodeName)}{&normalize($sub_table->getNodeName)}) {
                # This is a 1:N reference!
                # So this table can have multiple references to $sub_table
                #   So we need to stick ourself into the $sub_table as a FK
		        #
                # Our ID in this table is called:
                #   ${db_table_name}_FK_NAME
		        #
                # So we just got the PK of the 'N' table ($sub_table_index)
                # Later when we get the PK for this table we gotta update
		        #	that row we just created with that value
		        # BUT we won't know our PK 
                #   until we've actually been totally created - see below
                #   So we'll just remember to do it 4 now...
		        #
		        # Store sub table name & it's index so later we can put
		        #	our PK in there as the FK
		        my $stn = &mtn($sub_table->getNodeName);
                $set_our_pk_in_table{"$stn"}{$sub_table_index} = 1;
            }
            else {
                # Plain old 1:1 sub table - just get this table's PK
                #   & stick it in appropriate slot
                $values{&mtn("${db_st_name}_".PK_NAME)} = $sub_table_index;
            }
        }
    }

    #
    # We've completely filled out this table SO
    #   dump values into DB
    #   insert into $db_table_name %values...
    *insert = DBIx::Recordset->Setup({'!DataSource' => DSN,
                              '!Table' => "$db_table_name"});

    #
    # We can have a table that only has an PK_NAME value 
    #   we don't want that (it's like a <node/> entity)
    #   so fill in the 'value' column
    #
    if (!keys %values) {
        $values{$db_table_name."_value"} = 'present';
    }

    # Add the row

    # First generate a unique ID for this table
    my $PK = &generate_id($db_table_name);
    $values{"".PK_NAME} = $PK;

    # And add record
    $insert->Insert(\%values);

	# 
	# Now we just want to add a value into an existing record
	#	namely our PK in any 1:N table relationships
	#
    foreach my $sub_table_name (keys %set_our_pk_in_table) {
        foreach my $FPK (keys %{$set_our_pk_in_table{$sub_table_name}}) {

		        # Set up values
		        my (%insert);
		        $insert{id} = $FPK;
            	$insert{$db_table_name."_".FK_NAME} = $PK;

                # And update the table with our PK in its FK column
            	DBIx::Recordset->Update({%insert, 
				    ('!DataSource' => DSN, '!Table' => $sub_table_name,
			        	'!PrimKey' => PK_NAME)});
		}
	}
            
    # and return our PK - simple enough!
    return $PK
}

##
# Handy dandy sub to generate unique IDs using DBIx::Sequence
#   based on table name
##
sub generate_id
{
	my($table_name) = shift;
	$sequence->Next($table_name);
}