File Coverage

blib/lib/XML/RDB.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

#####
#
# $Id: RDB.pm,v 1.1 2003/04/18 00:33:17 trostler Exp $
#
# COPYRIGHT AND LICENSE
# Copyright (c) 2001, 2003, 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.
#
#####

package XML::RDB;

use XML::DOM;
use XML::RDB::MakeTables;
use XML::RDB::PopulateTables;
use XML::RDB::UnpopulateTables;
use XML::RDB::UnpopulateSchema;
use strict;

#####
#
# Copyright (c) 2001-2003  Juniper Networks, Inc.
# All rights reserved.
#
# Set of common routines & constants
#
#####
BEGIN {
        use Exporter ();
        use vars qw($VERSION); # @ISA @EXPORT);
        $VERSION = "1.3";
#        @ISA = qw(Exporter);
#        @EXPORT = qw(
#                    );
      }

sub new {
    my ($class, %arg) = @_;
    my $config;

    if ($arg{config_file}) {
      open(C, "$arg{config_file}") || die "$!";
      while() {
        next if (/^(#|$)/);
        next unless (my ($key, $value) = $_ =~ /^([A-Z_]+)=(.+)/);
        chomp $value;
        $key =~ s/\s//g;
        $value =~ s/\s//g;
        $config->{$key} = $value if ($key);
      }
      close(C);
    }
    elsif ( scalar(keys(%arg)) > 0 ) {
      $config = \%arg;
    }
    else {
      warn "$class requires a DSN for DBI->connect\n";
      return undef;
    }

    # setup connection
    my $dbh = DBI->connect(
                    $config->{DSN},
                    ($config->{DB_USERNAME} || ''),
                    ($config->{DB_PASSWORD} || ''),
                    { RaiseError => $config->{DB_RAISEERROR} || 0,
                      PrintError => $config->{DB_PRINTERROR} || 0,
                      # NOTE :
                      # autocommit needs to be on for this app in its current state.
                      # 1. the method of inserts, and updates
                      # 2. DBIx::Sequence
                      AutoCommit => 1 }
            ) or (( warn $!) and ( return undef));

    if ( $config->{DSN} =~ /dbi:sqlite/i) {
      warn("SQLite detected...setting SQLite PRAGMA: synchronus = OFF; locking_mode = EXCLUSIVE\n")
        if ($config->{DB_PRINTERR});
      $dbh->do('PRAGMA synchronous = OFF') || warn $dbh->errstr;
      $dbh->do('PRAGMA locking_mode = EXCLUSIVE') || warn $dbh->errstr;
    }

    $DBIx::Recordset::Debug         = $config->{DBIX_DEBUG}         || 0;
    $DBIx::Recordset::FetchsizeWarn = $config->{DBIX_FETCHSIZEWARN} || 0;

    my $self = bless {
                    DSN          => $config->{DSN},
                    DB_CATALOG   => (defined $config->{DB_CATALOG})
                                    ? $config->{DB_CATALOG}
                                    : undef,
                    DBH          => $dbh,
                    TEXT_COLUMN  => ($config->{TEXT_WIDTH})
                                    ? 'varchar('. $config->{TEXT_WIDTH} .')'
                                    : 'varchar(50)',
                    TEXT_WIDTH   => $config->{TEXT_WIDTH} || 50,
                    TAB          => ($config->{TAB}) ? ' ' x $config->{TAB} : '  ',
                    PK_NAME      => $config->{PK_NAME} || 'id',
                    FK_NAME      => $config->{FK_NAME} || 'fk',
                    TABLE_PREFIX => $config->{TABLE_PREFIX} || 'gen',
                    DB_USERNAME  => $config->{DB_USERNAME} || '',
                    DB_PASSWORD  => $config->{DB_PASSWORD} || '',
                    _HEADERS     => (defined $config->{SQL_HEADERS})
                                    ? $config->{SQL_HEADERS} : 1,
                    _SELECTS     => (defined $config->{SQL_SELECTS})
                                    ? $config->{SQL_SELECTS} : 1,
                    _SQLITE      => ($config->{DSN} =~ /dbi:sqlite/i) ? 1 : 0,
                  }, $class;

    $self->{REAL_ELEMENT_NAME_TABLE} = $self->mtn('element_names');
    $self->{LINK_TABLE_NAMES_TABLE}  = $self->mtn('link_tables');
    $self->{ROOT_TABLE_N_PK_TABLE}   = $self->mtn('root_n_pk');
    return $self;
}

sub done { my $self = shift; $self->DESTROY; return $self};

sub DESTROY {
  my $self = shift;

  # NOTE :  Recordset specific
  # Undef takes the name of a typglob and will destroy the array, the
  # hash, and the object. All unwritten data is  written to the db.
  # All db connections are closed and all memory is freed.
  # DBIx::Recordset::Undef ($name)
  # DBIx::Recordset->Flush();
  $self->{DBH}->disconnect() if ($self->{DBH});
  $self->{_DOC}->dispose     if ($self->{_DOC});
}

sub drop_tables {
  my $self = shift;
  return warn "Please add DB_CATALOG for the dsn supplied for dropping tables.\n"
    unless ( defined $self->{DB_CATALOG} );
  my $dbh = $self->{DBH};
  my ($driver, $dbname) = $self->{DSN} =~ /dbi:(\w+):\w+=(\w+)/i;
  my $sth;

  if    ( $self->{DB_CATALOG} == 0 ) {
    $sth = $dbh->table_info(undef, $dbname, undef, undef);
  }
  elsif ( $self->{DB_CATALOG} == 1 ) {
    $sth = $dbh->table_info($dbname, 'public', undef, undef);
  }
  else {
    return warn 'Please fix DB_CATALOG to boolean (1|0) in your dsn config file.'
               .'examples : Postgres 1, SQLite 0, Mysql 0' ."\n";
  }

  my $d_tables;
  my $regex = '^'. $self->{TABLE_PREFIX} .'_\w+';
  for my $rel (@{$sth->fetchall_arrayref({})}) {
    if ($rel->{TABLE_NAME} =~ /$regex/o) {
      push(@{ $d_tables }, $rel->{TABLE_NAME});
      $dbh->do('DROP TABLE '. $rel->{TABLE_NAME})
    }
  }
  return $d_tables;
}

sub create_tables {
my ($self, $file) = @_;
my $statement;

  open (F, $file) || die $!;
  while () {
    next if (/^(-|$)/); chomp;

    if (s/;$//) {
      $self->{DBH}->do($statement . $_) || die $self->{DBH}->errstr;
      $statement = '';
    }
    else {
      $statement .= $_;
    }
  }
  close(F);
  return $self;
}

sub _get_xml {
  my $self = shift;
  my $xmlfile = shift;

  if  (($self->{_XMLFILE}) and
       ((!$xmlfile) or ($self->{_XMLFILE} eq $xmlfile))) {
    undef;
  }
  elsif ($self->{DOC}) {
    $self->{_DOC}->dispose;
    $self->{_XMLFILE} = $xmlfile;
    $self->{_DOC} = $self->{_XMLPARSER}->parsefile($xmlfile);
    $self->{_HEAD} = $self->{_DOC}->getDocumentElement;
  }
  else {
    $self->{_XMLFILE} = $xmlfile;
    $self->{_XMLPARSER} = new XML::DOM::Parser;
    $self->{_DOC} = $self->{_XMLPARSER}->parsefile($xmlfile) || die "$!";
    $self->{_HEAD} = $self->{_DOC}->getDocumentElement;
  }
  return ($self->{_DOC},$self->{_HEAD});
}

sub make_tables {
  my ($self, $xmlfile, $outfile) = @_;
  my ($doc, $head) = $self->_get_xml($xmlfile);
  my $mt = new XML::RDB::MakeTables($self, $doc, $head, $outfile);
  $mt->go;
}

sub populate_tables {
  my ($self, $xmlfile) = @_;
  my ($doc, $head) = $self->_get_xml($xmlfile);
  my $pt = new XML::RDB::PopulateTables($self, $doc, $head);
  $pt->go;
}

sub unpopulate_tables {
  my $self = shift;
  my $outfile = shift;
  my $root_n_pk = $self->get_root_n_pk_db();
  my $ut = new XML::RDB::UnpopulateTables($self,$outfile);
  $ut->go($root_n_pk->{root}, $root_n_pk->{pk});
}

sub unpopulate_schema {
  my $us = new XML::RDB::UnpopulateSchema(@_);
  $us->go;
}

#
# Blow thru all nodes & find 1:N relationships between them
#   Need to pass the root of yer XML::DOM tree
# Quite pleasant really
# Basically just count the number of duplicate elements under
#   this one - if > 1 then 1:N relationship
#
sub find_one_to_n_relationships {
# NOTE : Replaced the recursive loop with goto's with a @stack
    my($self, $head) = @_;
    my (@stack,%saw,$one_to_n);
    TOP_REL:
    my $nodes = [ $head->getChildNodes ];
    %saw = ();

    # Count duplicates
    grep($saw{$_->getNodeName}++, @{$nodes});
    foreach (keys %saw) {
        next if /#text/;
        next if /#comment/;
        next if ($one_to_n->{$head->getNodeName}{$_});
        if ($saw{$_} > 1) {
            $one_to_n->{$head->getNodeName}{$_} = 1;
        }
    }

    TOPLESS_REL:
    # And recurse on down the road
    while (scalar(@{$nodes})) {
      my $sub_node =  shift(@{$nodes});
      next if ($sub_node->getNodeType == XML::DOM::TEXT_NODE);
      push(@stack, $nodes);
      $head = $sub_node;
      goto TOP_REL;
    }

  if (scalar(@stack) > 0) {
    $nodes = pop(@stack);
    goto TOPLESS_REL;
  }

  # Done is Done
  return $one_to_n;
}

#
# Helper function to dump the 'one_to_n' datastructure out
#
sub dump_otn {
  my $self = shift;
    my($otn, $char) = @_;
    my $ret;

    foreach my $one (keys %$otn) {
        foreach my $many (keys %{$otn->{$one}}) {
            $ret .= "${char}\t$one -> $many\n";
        }
    }
    return $ret;
}

#
# 'mtn' = 'Make Table Name' - cleans up text so it's a valid
#   DB table name & adds TABLE_PREFIX
#
sub mtn {
    my($self, $base, $out) = @_;
    ($out = $self->{TABLE_PREFIX} . "_$base") =~ y/#:\.-/_____/;
    lc $out;
}

# Normalize column/table names - No ':' or '-' & all lower case
sub normalize {
    my($in,$out) = shift;

    # Get rid of funny stuff
#    ($out = $in) =~ s/[#:\.-]/_/go;
    ($out = $in) =~ y/#:\.-/_____/;
    lc $out;
}

#
# Pulls out root_n_pk data from the DB itself
#
sub get_root_n_pk_db {
  my $self = shift;
  my $rt_n_pk;

  if ($self->{_SQLITE}) {
    my $sth = $self->{DBH}->prepare('select * from '. $self->{ROOT_TABLE_N_PK_TABLE});
    $sth->execute();
    my $row = $sth->fetch();
    $rt_n_pk = { root => $row->[1],  pk => $row->[0] }
      if ($row);
  }
  else {
    use vars qw(*root_n_pk);
    *root_n_pk = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
                                 '!Table' => $self->{ROOT_TABLE_N_PK_TABLE}});
    my $root;
    $root = $root_n_pk[0] if (@root_n_pk);
    $rt_n_pk = { root => $root->{root}, pk => $root->{pk} } if ($root);
    DBIx::Recordset::Undef ('*root_n_pk');
  }
  return $rt_n_pk;
}

#
# Pulls out one_to_n data structures from the DB itself
#
sub get_one_to_n_db {
  my $self = shift;
  my %one_to_n;

  if ($self->{_SQLITE}) {
    my $sth = $self->{DBH}->prepare('select * from '. $self->{LINK_TABLE_NAMES_TABLE});
    $sth->execute();
    while (my $row = $sth->fetch()) {
       $one_to_n{$row->[0]}{$row->[1]} = 1;
    }
  }
  else {
    use vars qw(*link_tables);
    *link_tables = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
                                 '!Table' => $self->{LINK_TABLE_NAMES_TABLE}});
    foreach my $links (@link_tables) {
        $one_to_n{$links->{one_table}}{$links->{many_table}} = 1;
    }
    #    *link_tables->Flush();
    DBIx::Recordset::Undef ('*link_tables');
  }
  return \%one_to_n;
}

sub get_real_element_names_db {
  my $self = shift;
  my $names;

  if ($self->{_SQLITE}) {
    my $sth = $self->{DBH}->prepare('select * from '. $self->{REAL_ELEMENT_NAME_TABLE});
    $sth->execute();
    while (my $row = $sth->fetch()) {
       $names->{$row->[0]} = $row->[1];
    }
  }
  else {
    use vars qw(*set);
    *set = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
                                    '!Table' => $self->{REAL_ELEMENT_NAME_TABLE}});
      foreach my $n (@set) {
          $names->{$n->{db_name}} = $n->{xml_name};
      }
      #    *link_tables->Flush();
    DBIx::Recordset::Undef ('*set');
  }
  return $names;
}


#
# Get the corresponding 'xml_name' from this 'db_name'
#
#sub get_xml_name {
#  my($self, $db_name) = @_;
#    my @set = DBIx::Recordset->Search({
#        '!DataSource' => $self->{DBH},
#        '!Table' => $self->{REAL_ELEMENT_NAME_TABLE},
#        '$where' => 'db_name = ?',
#        '$values' => [ $db_name ],
#      });
#
#    $set[0]{xml_name};
#}

#
# Recursive routine to unpopulate DB into in-memory data structure
#
# Takes a table name, PK of a row, & a hash ref of where in this
#   giant monstrous data in-memory data-structure we've created to
#   stick this row's values
#

sub un_populate_table {
    my($self, $one_to_n, $table_name, $id, $put_it_here) = @_;
    my $match = "_" . $self->{PK_NAME};
    my(@stack, $schema_names, $jj, $other_table, $fk_field, $links, $kk, $i );
    use vars qw(*schema);   # DBIx::Recordset likes GLOBs, yummy

    TOP_TBL:
    ( $jj, $other_table, $fk_field, $links, $kk, $i ) = ();

    # This'll get the ball rolling...
    *schema = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
                                       '!Table' => $table_name,
                                        $self->{PK_NAME} => $id
                                        });
    # Any column that ends in '_id' we gotta assume is a 1:1 map
    # Any column that ends in '_value' is text in this element
    # Any column that ends in '_attribute' is an attribute

    $schema_names = $schema->Names;

#    foreach my $col (@{$schema->Names}) {
    for ($jj = 0; scalar(@{$schema_names}) > $jj; $jj++) {
        my $col = $schema_names->[$jj];
        my $val = $schema[0]{$col};

        if ($col =~ /${match}$/o) {
            # 1:1
            next if (!$val);

            # Unpopulate sub table since this is a foreign key
            my $this_table;
            ($this_table = $col) =~ s/${match}$//;
#            $self->un_populate_table($one_to_n, $other_table, $val, \%{$put_it_here->{$other_table}});

            push(@stack, [ $table_name, $id, $put_it_here, $schema_names, $jj,
                           $other_table, $fk_field, $links, $kk, $i ]);
            ($table_name, $id, $put_it_here ) =
              ($this_table, $val, \%{$put_it_here->{$this_table}});
            goto TOP_TBL;
            TOPLESS_TBL_1to1:

            # Put the candle - back
            *schema = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
                                               '!Table' => $table_name,
                                               $self->{PK_NAME} => $id});

        }
        elsif ($col =~ /_value$/o) {
            # text between tag
            $put_it_here->{value} = $val if (defined $val);
        }
        elsif ($col =~ /_attribute$/o) {
            # attribute
            $put_it_here->{attribute}{$col} = $val if (defined $val);
        }
        elsif ($col eq $self->{PK_NAME}) {
            # PK - don't do anything
        }
        elsif ($col =~ /_$self->{FK_NAME}$/o ) {
            # FK - don't do anything
        }
        else {
            # Keep us honest
            die "I don't know what to do with column name $col = $val!\n";
        }
    }

    # Now get 1:N relationships
    if ($one_to_n->{$table_name}) {
        # Go thru each 'N' relationship table to this one

          $links = [ keys %{$one_to_n->{$table_name}} ];

          for ($kk = 0; scalar(@{$links}) > $kk; $kk++) {
            my $link = $links->[$kk];

            # Look up other PK via our PK (which is an FK in the sub_table)
            $other_table = $self->mtn($link);
    	    $fk_field = $table_name."_" . $self->{FK_NAME};

            # Look up matching row in other (linked) table
    	        # Get rows from other table with a $fk_field matching
    	        #	this one's
            *schema = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
                                   '!Table' => $other_table,
                                    "$fk_field" => $id});

            $i = 0;
            while(my $other_pk = $schema[$i]{$self->{PK_NAME}}) {
                next if (!$other_pk);
                # use $i in name to keep 'em seperate
                #   & recursively unpopulate that other table
#                $self->un_populate_table($one_to_n, $other_table, $other_pk, \%{$put_it_here->{$i}{"${other_table}"}});

                push(@stack, [ $table_name, $id, $put_it_here, $schema_names, $jj,
                               $other_table, $fk_field, $links, $kk, $i ]);
                ($table_name, $id, $put_it_here ) =
                  ($other_table, $other_pk, \%{$put_it_here->{$i}{"${other_table}"}});

                goto TOP_TBL;
                TOPLESS_TBL_FK:

                # Put The Candle - Back
                *schema = DBIx::Recordset->Search({'!DataSource'=>$self->{DBH},
                                   '!Table' => $other_table,
                                    "$fk_field" => $id});
                $i++;
            }
        }
    }

  if (scalar(@stack) > 0) {
    ( $table_name, $id, $put_it_here, $schema_names, $jj,
      $other_table, $fk_field, $links, $kk, $i ) = @{pop(@stack)};
    unless ($other_table) {  goto TOPLESS_TBL_1to1;  }
                     else {  goto TOPLESS_TBL_FK;    }
  }

    DBIx::Recordset::Undef ('*schema');
}




#sub un_populate_table {
#    my($self, $one_to_n, $table_name, $id, $put_it_here) = @_;
#    use vars qw(*schema);   # DBIx::Recordset likes GLOBs, yummy
#
#    # This'll get the ball rolling...
#    *schema = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
#                                       '!Table' => $table_name,
#                                        $self->{PK_NAME} => $id
#                                        });
#    # Any column that ends in '_id' we gotta assume is a 1:1 map
#    # Any column that ends in '_value' is text in this element
#    # Any column that ends in '_attribute' is an attribute
#    foreach my $col (@{$schema->Names}) {
#        my $val = $schema[0]{$col};
#        my $match = "_" . $self->{PK_NAME};
#
#        if ($col =~ /${match}$/) {
#            # 1:1
#            next if (!$val);
#
#            # Unpopulate sub table since this is a foreign key
#            my $other_table;
#            ($other_table = $col) =~ s/${match}$//;
#            $self->un_populate_table($one_to_n, $other_table, $val, \%{$put_it_here->{$other_table}});
#            # Put the candle - back
#            *schema = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
#                                               '!Table' => $table_name,
#                                               $self->{PK_NAME} => $id});
#
#        }
#        elsif ($col =~ /_value$/) {
#            # text between tag
#            $put_it_here->{value} = $val if (defined $val);
#        }
#        elsif ($col =~ /_attribute$/) {
#            # attribute
#            $put_it_here->{attribute}{$col} = $val if (defined $val);
#        }
#        elsif ($col eq $self->{PK_NAME}) {
#            # PK - don't do anything
#        }
#        elsif ($col =~ /_$self->{FK_NAME}$/ ) {
#            # FK - don't do anything
#        }
#        else {
#            # Keep us honest
#            die "I don't know what to do with column name $col = $val!\n";
#        }
#    }
#
#    # Now get 1:N relationships
#    if ($one_to_n->{$table_name}) {
#        # Go thru each 'N' relationship table to this one
#        foreach my $link (keys %{$one_to_n->{$table_name}}) {
#            # Look up other PK via our PK (which is an FK in the sub_table)
#            my $other_table = $self->mtn($link);
#    	        my $fk_field = $table_name."_" . $self->{FK_NAME};
#
#            # Look up matching row in other (linked) table
#    	        # Get rows from other table with a $fk_field matching
#    	        #	this one's
#            *schema = DBIx::Recordset->Search({'!DataSource' => $self->{DBH},
#                                   '!Table' => $other_table,
#                                    "$fk_field" => $id});
#            my $i = 0;
#            while(my $other_pk = $schema[$i]{$self->{PK_NAME}}) {
#                next if (!$other_pk);
#                # use $i in name to keep 'em seperate
#                #   & recursively unpopulate that other table
#                $self->un_populate_table($one_to_n, $other_table, $other_pk, \%{$put_it_here->{$i}{"${other_table}"}});
#
#                # Put The Candle - Back
#                *schema = DBIx::Recordset->Search({'!DataSource'=>$self->{DBH},
#                                   '!Table' => $other_table,
#                                    "$fk_field" => $id});
#                $i++;
#            }
#        }
#    }
##    *schema->Flush();
#    DBIx::Recordset::Undef ('*schema');
#}

1;
__END__