package DBIx::XML::DataLoader;
my $VERSION="1.0b";
use warnings;
use strict;
use XML::XPath;
use LWP::UserAgent;
use Storable qw(dclone);
use DBIx::XML::DataLoader::MapIt;
use DBIx::XML::DataLoader::DB;
use DBIx::XML::DataLoader::IsDefined;
###########
sub new{
########
my $class=shift;
my $self={};
my %args=@_;
my $map=$args{map};
#if(!$map){die "a map file is required for creating a new object\n";}
$self->{dbmode}=$args{dbmode}||"insertupdate";
$self->{dbprint}=$args{dbprint}||undef;
my $dbprint=$args{dbprint}||$self->{dbprint}||undef;
my $dbmode=$args{dbmode}||$self->{dbmode}||"insertupdate";
$self->{map}=$args{map}||undef;
$self->{xml}=$args{xml}||undef;
my @classmap=DBIx::XML::DataLoader::MapIt->mapclasses($map);
my @tables=@{$classmap[4]};
my $dbinfo=$classmap[1];
my $db_connections;
my $db=DBIx::XML::DataLoader::DB->new(dbmode=>$dbmode, dbprint=>$dbprint);
$self->{db}=$db;
if($dbinfo){
for my $keys (keys %{$dbinfo}){
my $dbuser=$dbinfo->{$keys}->{dbuser};
my $dbpass=$dbinfo->{$keys}->{dbpass};
my $dbsource=$dbinfo->{$keys}->{dbsource};
my $dbh;
$dbh=$db->DBConnect($dbuser,$dbpass,$dbsource);
$db_connections->{$keys}=$dbh;
}
}
$self->{db_connections}=$db_connections;
$self->{classmap}=\@classmap;
$self->{tables}=\@tables;
bless ($self, $class);
###############
} # end sub new
#######################
#############################
sub processxml{
################
if(scalar @_ < 3){die "failed to provide the proper arguments of xml, and map file @_\n";}
##################
no strict 'refs';
my $self=shift;
my %args=@_;
$XML::XPath::Namespaces=0;
my $dbprint=$args{dbprint}||$self->{dbprint}||undef;
my $dbmode=$args{dbmode}||$self->{dbmode}||"insertupdate";
my $file_count=$args{count};
my @classmap = @{$self->{classmap}};
my $xml=$args{xml};
if($xml){$self->{xml}=$xml;}
#my $map=$args{map}||$self->{map};
my @allxmlfiles;
my @allxmldocs_processed;
my @everybitofdata;
my @errors;
my $suberrors;
my $dbmessage;
my $message;
my @sqlload;
my $dberror;
##################################################################
### here we process our map file and get the db and xml document
### structure information we need to continue
###
my $tables=$classmap[4];
my $table_ref=$classmap[3];
my $rootelement=$classmap[2];
my $dbinfo=$classmap[1];
####### here we make all the needed database connections
my $db_connections=$self->{db_connections};
my $db=$self->{db};
my $thesubs=$classmap[0];
my @tables=@{$tables};
#######################################################
## here we run the pre parse subroutines
{no warnings; #warnings are turned off so that we will not get complaints
# if runsubs returns no value;
my ($serror, undef)=_runsubs($db_connections,$thesubs, 'prexml');
$suberrors.=$serror;
}
##################################################
#$XML::XPath::SafeMod;
### we now start looping through our xml files
###we do subroutine and db inserts one xml file at a time
my $all_xml;
my $current_xml;
my @arrayofallinserts;
#############################################################################
## here we will check to make sure the files and directories requested
## exists
if(!$xml){warn "we had no xml sent in";return;}
if($xml =~ /^http:/){
my $ua = new LWP::UserAgent;
$ua->agent("DBIx_XML_DataLoader/1.0b " . $ua->agent);
my $req = new HTTP::Request(GET=>$xml);
my $res = $ua->request($req);
if ($res->is_success){
$xml=$res->content;
}
}
if($xml =~ /^http:/){die "we did not get the remote xml map file you requested";}
if($xml !~ /\</gm){
my $xmltype=(stat($xml))[2];
if($xmltype=~ /^1/){die "ERROR: The file is a directory not a regular file";}
if(!$xmltype){die "ERROR: The file you entered does not exist";}
return unless (eval{$all_xml = XML::XPath->new(filename => $xml);});
}
if($xml =~ /\</gm){
return unless (eval{$all_xml = XML::XPath->new(xml => $xml);});
}
##########################################################################################
## below we loop through each table
## and loop through the input xml file looking for items that belong in this table
## once we fill all the required columns in the table we execute our SQL and empty
## our colection of values and try to fill the required fields again we continue
## through the document until we have no more value we can use. Then we start a new table.
###########################################################################################
my $loopcount;
TABLE: for my $table (@tables){
$message.= "working with table $table\n";
my @table_info=@{$table_ref->{$table}};
my $table_details=pop @table_info;
my @cols=@{$table_details->{columns}};
my @hashof_thekeys=@{$table_details->{keys}};
my @thekeys;
for my $hash_thekey (@hashof_thekeys){
for my $key (keys %{$hash_thekey}){push @thekeys, $hash_thekey->{$key};}
}
my $keyelement=$table_details->{xpath};
my $dbname=$table_details->{dbname};
my $handlers=$table_details->{handlers};
my @tabprep;
my %table;
my $table_ref;
my @incols;
&_runtablesubs($db_connections,$handlers, 'TABLE', 'prexml');
my $count=scalar @cols;
my @insdbh;
my @upddbh;
my @upkeys;
my $date;
### we are going to try to do this looping through the map file calssmap array
### looking for values that match up in the $all_xmlmap hash referance.
###
my @currentkeys=@thekeys;
my $current_class;
my $current;
my @allglobals;
my @allresults;
my %array_count;
my $section_count;
my $subsection_count;
my $element_count;
my $nodecounter;
my $newloop="yes";
if(!$rootelement){$rootelement="/*";}
my @allnodes;
return unless (eval{ @allnodes = $all_xml->findnodes("$rootelement");});
BASENODE: while (@allnodes){
my $thenode=pop @allnodes;
my @all_tab_nodes;
next unless (eval { @all_tab_nodes= $thenode->findnodes("$keyelement");});
NODES: while (@all_tab_nodes){
my $node =shift @all_tab_nodes;
CLASSLOOP: for my $class (@table_info){
my $xpath=$class->{xpath};
my $default = $class->{default};
my $item=$default;
my $itemvalue=$node->findvalue($xpath);
$itemvalue=~s/\s+/ /g;
## added for testing comment out when in production
#if($class->{col} eq "computer_name"){$itemvalue="Comp $file_count";}
## new routine in module IsDefined.pm will check to make sure a avriable has a value
if(defined DBIx::XML::DataLoader::IsDefined->verify($itemvalue)){$item = $itemvalue;}
if($handlers->{$class->{col}}){
HANDLERS:
for my $key (sort keys %{$handlers->{$class->{col}}}){
my $sub;
my $handler=$handlers->{$class->{col}}->{$key}->{handler};
if($handler !~ /^sub/){
$handler=~s/>/>/;
my ($package, $subroutine)=split /\-\>/, $handler;
my $mod_name=$package.".pm";
&_printsuberror($mod_name, $@) unless eval {require $mod_name};
my @substuff;
push @substuff, $item,$handlers->{$class->{col}}->{$key}->{args},$db_connections->{$handlers->{$class->{col}}->{$key}->{dbname}};
&_printsuberror("$package->$subroutine", $@) unless (eval{$item=$package->$subroutine($item,$handlers->{$class->{col}}->{$key}->{args},$db_connections->{$handlers->{$class->{col}}->{$key}->{dbname}})});
}
if($handler=~ /^sub\{/){
$handler=~s/\&/\&/g;
$handler=~s/\"/\"/g;
my $subroutine=$handler;
$sub=eval "$subroutine";
{
no warnings;
&_printsuberror($sub, $@) unless (eval {$item= &$sub($item,$handlers->{$class->{col}}->{$key}->{args},$db_connections->{$handlers->{$class->{col}}->{$key}->{dbname}})});
}
}
} # end loop HANDLERS
} # if handlers
if($class->{col}=~ /^UPDATE_DTTM$|^CREATE_DTTM$/){$item="SYSDATE";}
my $key;
KEYS: for my $ckeys(@currentkeys){
if($ckeys eq $class->{col}){$key="yes";last KEYS;}
} # end loop for keys;
if($class->{date}){
my $conv_item=$db->sqldate($db_connections->{$dbname}, $item, $class->{date},$table);
$item=$conv_item;}
if(not defined $item){undef @allresults; next NODES;}
#{undef @allresults; next NODES;} unless (defined $item);
#print "Col: ",$class->{col}," Val: $item\n";
if(!$key){push @allresults, {val=>$item, col=>$class->{col}};}
if($key){push @allresults, {val=>$item, col=>$class->{col}, key=>$key};}
if((scalar @allresults) eq (scalar @cols)){
my ($tserror, $results)=_runtablesubs($db_connections,$handlers, 'TABLE', 'predb',\@allresults);
if($tserror){$suberrors.=$tserror;}
if($results){@allresults=@{$results};}
push @arrayofallinserts, {results=>[@allresults], table=>$table, keys=>\@hashof_thekeys,
cols=>\@cols, dbname=>$dbname};
undef @allresults;
next NODES;
} # end if (scalar @allresults eq scalar @thecols) and (scalar @currentkeys) <= 0)
} # end loop CLASSLOOP
} # end NODES
} # end BASENODE
} # end TABLE loop
#############################################################################################
## we have all of our data organized now we will prepare to run
## any subs that have been passed to us from the map file and
## do the database insertion or update
############################################################################################
# we will do this so tah our subs have access to the db
############################################################################
## here we will walk through our extra subroutines listed in the map file###
############################################################################
{no warnings; #warnings are turned off so that we will not get complaints
# if runsubs returns no value;
my ($serror, $allinserts)=_runsubs($db_connections,$thesubs, 'predb', \@arrayofallinserts);
if($allinserts =~ /^ARRAY/){
@arrayofallinserts=@{$allinserts};
}
$suberrors.=$serror;
}
#####################################################################
## we now run the actual database insertion/update subroutine dosql##
#####################################################################
if($dbinfo){
my ($response, $error,$load)=$db->DBInsertUpdate(datainfo=>\@arrayofallinserts, dbprint=>$dbprint,
dbconnections=>$db_connections, dbmode=>$dbmode);
if($response){$dbmessage.=$response;}
if($error){ $dberror.=$error;}
if($load){push @sqlload, $load;}
}
############################ All Done ##############################
#&runsubs("postdb",\@subs, \@arrayofallinserts);
#my $olddbh=pop @arrayofallinserts;
push @everybitofdata, \@arrayofallinserts;
$all_xml->cleanup();
{no warnings; #warnings are turned off so that we will not get complaints
# if runsubs returns no value;
my ($serror, $allinserts)=_runsubs($db_connections,$thesubs, 'postdb', \@everybitofdata);
$suberrors.=$serror;
}
#"We Attempted to Process the XML Document ".(join "\n", @allxmlfiles).
$message .=
"\nThe Following XML Document had data suitable for insertion into our database\n".
(join "\n", @allxmldocs_processed).
"\n____________________________________________________________\n";
#my %stuff=(message=>$message, dbmessage=>$dbmessage, suberrors=>$suberrors,dberrors=>$dberror, sqlload=>[@sqlload]);
return ($self,{message=>$message, dbmessage=>$dbmessage,suberrors=>$suberrors,dberrors=>$dberror,sqlload=>[@sqlload]});
} # end sub processxml;
sub _printsuberror{
no warnings; # here incase we do not pass all the vars we are expecting
my $package=shift;
my $error=shift;
my $theerrors= "We had a problem running $package, the error reported was $error\n";
return($theerrors);
}
sub _runsubs{
no warnings; # used to keep any subs from causing warnings.
# errors actually generated by the subroutine that runsub will be calling
# are returned by runsubs
my $thesuberrors;
#my $self=shift;
my $db_connections=shift;
my $insubs=shift;
my $when=shift;
my $data=shift;
my $sub_response=$data;
if(!$insubs){return;} # chnaged here;
my %subs=%{$insubs->{$when}};
for my $key (sort keys %subs){
$data=$sub_response;
my $handler=$subs{$key}->{name};
my $args=$subs{$key}->{args};
my $dbname=$subs{$key}->{dbname};
my $dbconnect;
if($dbname){$dbconnect=$db_connections->{$dbname};}
if($handler !~ /^sub/){
$handler=~s/>/>/;
my ($package, $subroutine)=split /\-\>/, $handler;
my $mod_name=$package.".pm";
$thesuberrors.=_printsuberror($mod_name, $@)
unless eval {require $mod_name};
$thesuberrors.=_printsuberror("$package->$subroutine",$@) unless
(eval {$sub_response=$package->$subroutine($args, $data,
$dbconnect);});
}
if($handler=~ /^sub\{/){
$handler=~s/\&/\&/g;
$handler=~s/\"/\"/g;
my $subroutine=$handler;
my $sub=eval "$subroutine";
$thesuberrors.=_printsuberror($sub, $@)
unless (eval {$sub_response= &$sub($args, $data, $dbconnect);});
}
}
return($thesuberrors, $sub_response);
}
sub _runtablesubs{
no warnings; # used to keep any subs from causing warnings.
# errors actually generated by the subroutine that runtablesub will be calling
# are returned by runsubs
#my $self=shift;
my $db_connections=shift;
my $handlers=shift;
my $place=shift;
my $when=shift;
my $indata=shift;
my $data=$indata;
my $subresponse=$data;
my $suberrors;
if($handlers->{$place}){
HANDLERS:
for my $key (sort keys %{$handlers->{$place}->{$when}}){
if($subresponse){$data=$subresponse;}
my $sub;
my $handler=$handlers->{$place}->{$when}->{$key}->{handler};
if($handler !~ /^sub/){
$handler=~s/>/>/;
my ($package, $subroutine)=split /\-\>/, $handler;
my $mod_name=$package.".pm";
$suberrors.=_printsuberror($mod_name, $@) unless eval {require $mod_name};
$suberrors.=_printsuberror("$package->$subroutine", $@) unless (eval
{$subresponse=$package->$subroutine($handlers->{$place}->{$when}->{$key}->{args},$db_connections->{$handlers->{$place}->{$when}->{$key}->{dbname}},$data)});
}
if($handler=~ /^sub\{/){
$handler=~s/\&/\&/g;
$handler=~s/\"/\"/g;
my $subroutine=$handler;
$sub=eval "$subroutine";
$suberrors.=_printsuberror($sub, $@) unless
(eval
{$subresponse=&$sub($handlers->{$place}->{$when}->{$key}->{args},$db_connections->{$handlers->{$place}->{$when}->{$key}->{dbname}},$data)});
if(!$subresponse){$subresponse=$data;}
}
} # end loop HANDLERS
} # if handlers
if(!$subresponse){$subresponse=$data;}
return($suberrors,$subresponse);
#################
} # end sub _runtablesubs
#######################
1;
__END__
=head1 NAME
DBIx::XML::DataLoader
=head1 SYNOPSIS
use DBIx::XML::DataLoader;
my $mapper=DBIx::XML::DataLoader->new(map=>"map.xml");
my $response=$mapper->processxml(xml=>"data.xml");
=head1 DESCRIPTION
DBIx::XML::DataLoader contains a set of modules that are meant to work together.
DBIx::XML::DataLoader.pm the core for this package
DB.pm which contains the sql specific stuff
MapIt.pm handles parsing the xml mapping file
IsDefined.pm a simple module for making sure empty data sets are defined
dataloader uses a external map(see map instructions below) file written
in xml to find its instructions for handling the data contained in the
xml data files that will be imported.
=head1 SIMPLE EXAMPLE
use DBIx::XML::DataLoader;
#Create a new object
my $mapper=DBIx::XML::DataLoader->new(map=>"map.xml");
my $response=$mapper->processxml(xml=>"data.xml");
#$response will contain a hash referance with the information outputted by the module.
$response->{mesage}; # The message generated by module
$response->{dbmessage}; # the message generated by DBIx::XML::DataLoader::DB.pm
$response->{suberrors}; # errors generated by the subroutines
$response->{dberrors}; # errors generated by DBIx::XML::DataLoader::DB.pm
$responce->{sqlload}; # data formatted to be suitable for inserting using sqllaoder
# requires you set the dbmode to sqlloader
=head1 OPTIONAL USAGE
new() can be passed serveral other options besides "map"
Required
map: The map file to be used. This can be a xml fragment
a xml file on the local machine or a url to a xml map file.
Optional
dbmode: this can be set to insert, update, insertupdate, or
sqlloader
insert: will have db.pm only do inserts
update: will have db.pm only do updates
insert/update: the default setting will attempt to insert data
and then it will try to do a update.
sqlloader: will generate data formatted in a way so it can be
written to a DAT file for sqlloader(Oracle). This data will be
returned in $response->{sqlload}.
dbprint: this is used to control whether we actually do the database
work or simulate it by printing the statements to $response->{dbmessage}.
This can be set to db, print, or dbprint.
db: will tell DBIx::XML::DataLoader::DB.pm to just do the assinged dbmode
print: will tell DBIx::XML::DataLoader::DB.pm to simulate the dbmode and return in
dbmessage the sql statement that would have been created.
dbprint: will cause the db.pm module to do both the actual
assigned dbmode and the printed output.
processxml() Needs to have a xml file containing the data.
xml: This can be a xml fragment of xml, a xml file on the server,
or a url to a xml file.
=head1 EXAMPLE SIMPLE MAPFILE
<XMLtoDB>
<dbinfo dbuser="db_user_login" dbpass="db_pass_login"
dbsource="data_source" name="a_identifier"/>
<RootElement name="name_of_xml_doc_root"/>
<Table name="db_table_name" db_name="a valid dbinfo name attribute value"
xpath="./xpath_of_tables_root_node">
<KeyColumn name="a db query
key" order="The more common a key values should be given a higher number"/>
<Element xpath="./xpath_to_node" toColumn="sql db column name"/>
</Table>
</XMLtoDB>
=head1 MAP FILE RULES
=head1 Exceptable Map File Tags
=head2 dbinfo
Tag containing attributes with the database user name, password,
data source, and name.
1) Attribute name for database user is dbuser
2) Attribute name for database password is dbpass
3) Attribute name for database source is dbsource
4) Attribute name for database name is name
=head2 Sub
This tag is for listing subroutines you would like called prior
to doing the main database insertion/update.
1) Required attributes for this tag are name and rank.
2) Modules containing the subroutines should be kept in @INC
3) The name attribute needs to have the package name and the
subroutine name that will be called. It needs to written as
package->subroutine
4) The when attribute is used to tell the program when to run the subroutine.
The options would be prexml, predb, postdb, and postxml.
5) The rank attribute need to be set to a number. Rank starts at 1
and goes up from there. Subs with he lowest rank will be ran first.
Consecutive numbers must be used for setting rank.
6) A optional attribute of args can be used to pass arguments to the
subroutine being called.
=head2 DocKeyColumn
This is a Key db column that is common to multiple tables in the
xml document.
1) the attribute for this tag is name. This attribute should be set
to the db column name that is common.
=head2 RootElement
The base element for the document
1) tag has a attributes of name. The name should be set to the documents root
element name
=head2 Table
The area containing table data inforamtion. Tag attributes are name and dbname
1) name should be set to a db table name
2) dbname should be set to a valid dbinfo name attribute value
3) xpath shoud be set to the base xpath of the table
=head2 Handler
This tag is for passing subroutines durring processing of tables or data
contained in a Element. When Handler is outside a Element then it will be
considered belonging to the Table. Table level handlers have three attributes.
They are name, when, and rank. Only rank is optional. Element level handlers
require only the name attribute but can also have a rank attribute if more than
handler will be called on this data value.
1) The attribute name should be set to a subroutine in @INC or code containing
the actual subroutine. If passing code lable it sub and wrap the code in
brackets (ie. sub{$ _[0]="hello";} would change the value comming
in to "hello")
2) The value for when should be predb or postdb (table level handlers only)
3) The value for rank should be set based on what order you want handlers with
the same parents should be called. The lower the number the earlier it will
be called.
=head2 KeyColumn
This is one of the key in the database for the table. The attributes for this
tag are name and order.
1) the attribute name should be set to the name of the column in the table.
2) the attribute order should be set based on the previlance of the column
value in the database(ie. driveletter might be common but computername
in the same row may be more unique. So the order value for computername
would be give a lower number and driveletter a highter value for order).
=head2 Element
A Element is how we identify xml nodes containing our data. The attributes
that are required are xpath, toColumn.
1) The attribute xpath should be set to the xpath of the node relative to
the xpath of Table.
2) The attribute toColumn should be set to the column name in the db.
=head1 Also see man page for
=for man DBIx::XML::DataLoader::XMLWriter, DBIx::XML::DataLoader::MapIt, DBIx::XML::DataLoader::DB, DBIx::XML::DataLoader::IsDefined, and DBIx::XML::DataLoader::Date
=for text DBIx::XML::DataLoader::XMLWriter, DBIx::XML::DataLoader::MapIt, and DBIx::XML::DataLoader::DB, DBIx::XML::DataLoader::IsDefined, and DBIx::XML::DataLoader::Date
=for html
=for html
<a href="XMLWriter.html">DBIx::XML::DataLoader::XMLWriter</a>,
=for html
<a href="MapIt.html">DBIx::XML::DataLoader::MapIt<a/>, <a href="DB.html">DBIx::XML::DataLoader::DB</a>,
=for html
<a href="IsDefined.html">DBIx::XML::DataLoader::IsDefined<a/>, and <a href="Date.html">DBIx::XML::DataLoader::Date</a>
=for html
<p><hr><p><p><P>