view release on metacpan or  search on metacpan

DataLoader/MapIt.pm  view on Meta::CPAN

package DBIx::XML::DataLoader::MapIt;

use strict;
use warnings;

###############
sub new{
########
my $self = shift;

bless \$self;
########
} # end sub new
################


#######################
sub mapclasses{
###############

use XML::XPath;
use LWP::UserAgent;

my @mapclasses;

my $self=shift;
my $filename=shift;
my $all_tables;
my @globals;
my @tables;
my @loc_globals;
my @subs;
my $thesubs;
my $rootelement;
my $data_sources;
my $doc_key;
my $xp;
{
no warnings;  # warnings are turned off because the XML::XPath 
	      #	generates warnings when we attempt to find node values


# added http requests for map files
if($filename =~ /http/){
my         $ua = new LWP::UserAgent;
         $ua->agent("DBIx::XML::DataLoader/1.0b " . $ua->agent);
my $req = new HTTP::Request(GET=>$filename);
my $res = $ua->request($req);

if ($res->is_success){
             $filename=$res->content;
         }
}
if($filename =~ /^http:/){die "we did not get the remote xml map file you requested";}

if($filename !~ /\</mg){$xp = XML::XPath->new(filename => $filename);}
if($filename =~ /\</mg){$xp = XML::XPath->new(xml => $filename);}


my ($mapcol,$maptable,$mappath,$mapvar,$maptag,
        $mapkeys, $mapele, $mapsec, $mapatt,
        $mapsub, $mapglb,$maplglb);
my $path;
my $nodeset = $xp->findnodes('/XMLtoDB/*');
NODE: foreach my $node ($nodeset->get_nodelist) {

	my $elename=XML::XPath::Node::Element::getName($node);
if(($elename) and ($elename eq "DocKeyColumn")){
my @attributes= XML::XPath::Node::Element::getAttributes($node);
for my  $att_nodes (@attributes){
my $att=XML::XPath::Node::Attribute::getData($att_nodes);
my $att_name=XML::XPath::Node::Attribute::getName($att_nodes);
if(($att_name) and ($att_name eq "name")){$doc_key=$att;}
}
}
############## here we get the Sub tag(subroutine) info and the db, and rootelement.
###################################################################################
	if(($elename) and ($elename eq "dbinfo")){
my ($dbuser, $dbpass, $dbsource, $name);

		my @attributes= XML::XPath::Node::Element::getAttributes($node);
		for my $att_nodes (@attributes){
			my $att=XML::XPath::Node::Attribute::getData($att_nodes);
			my $att_name=XML::XPath::Node::Attribute::getName($att_nodes);
			if($att_name){
			if($att_name eq "dbpass"){$dbpass=$att;}
			if($att_name eq "dbuser"){$dbuser=$att;}
			if($att_name eq "dbsource"){$dbsource=$att;}
			if($att_name eq "name"){$name=$att;}
		}
		} # end for @attributes
$data_sources->{$name}={dbuser=>$dbuser, dbpass=>$dbpass, dbsource=>$dbsource};
	} # end dbinfo
	if(($elename) and (($elename eq "Handler")or($elename eq "Sub"))){
		my $subname;
		my $subrank;
		my $subargs;
		my $subwhen;
		my $dbname;
		my @attributes= XML::XPath::Node::Element::getAttributes($node);
		for my $att_nodes (@attributes){
			my $att=XML::XPath::Node::Attribute::getData($att_nodes);
			my $att_name=XML::XPath::Node::Attribute::getName($att_nodes);
			if($att_name){
			if($att_name eq "name"){$subname=$att;}
			if($att_name eq "args"){$subargs=$att;}
			if($att_name eq "rank"){$subrank=$att;}