DBIx-XML-DataLoader

 view release on metacpan or  search on metacpan

DataLoader/XMLWriter.pm  view on Meta::CPAN

my $date=DBIx::XML::DataLoader::Date->now();

my $rootcnt="0";
##############################################
### here we walk though all the db results
## building our xml doc as we go.
###############################################
my @all_finished_tables;
my @allthekeys;
KEY_LOOP: for my $keys (sort keys %all_data){push @allthekeys, $keys;}
my @testkeys=@allthekeys;

TABLE_LOOP: 
while (@allthekeys){
my $keys= shift @allthekeys;
my $table_node=$all_data{$keys}->{node};
my %table_pass;
my $fparent;
if($all_data{$keys}->{parent}){

	PARENTCHECK:for my $finished_tables (@all_finished_tables){
		if($finished_tables eq $all_data{$keys}->{parent}){
		$fparent="yes";
		last PARENTCHECK;
		}
	}

if(!$fparent){
$fparent="yes";
BPARENTCHECK: for my $test_table (@allthekeys){
if($test_table eq $all_data{$keys}->{parent}){
	$fparent=undef;last BPARENTCHECK;
	}
	}
}

if(!$fparent){push @allthekeys, $keys;next TABLE_LOOP;}
}


push @all_finished_tables, $keys;
$table_pass{parent}->{hasone}="no";
my $dbname=$all_data{$keys}->{dbname};
if($all_data{$keys}->{data}){
LOOPCNT: for my $lpcnt (sort keys %{$all_data{$keys}->{data}}){

my $table_xpath=$all_data{$keys}->{xpath};
$table_xpath=~ s[^\./][];
my $the_root=$doc_root;
my @info=@{$all_data{$keys}->{data}->{$lpcnt}};
my $tableroot=$all_data{$keys}->{node};
my %table_doc;
INFO: for my $info (@info){
my $value=$info->{val};
### here we set any values that have xpaths starting from the document root
## this seems to work
if($info->{xpath} =~ m[^/]){
## do root doc stuff here
my $xpath=$info->{xpath};
$xpath =~ s[^/+][];
my @path=split m[/], $xpath;
my $the_root=shift @path;
my $path_cnt=scalar @path;
#my $value=$info->{val};
	if($path_cnt==1){
	if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[0]){
	$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[0]=$value;
	next INFO;}
	 if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[0]){
        if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[0] ne $value){
	$rootcnt++;
	$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[0]=$value;
	next INFO;
	}

      	}

	} 

if($path_cnt==2){
if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0] ne $value){
$rootcnt++;
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
}

}
if($path_cnt==3){
if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0] ne $value){
$rootcnt++;
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
}

}
if($path_cnt==4){
if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0] ne $value){
$rootcnt++;
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
}
}
if($path_cnt==5){
if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0] 
ne $value){
$rootcnt++;
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
}
}
if($path_cnt==6){
if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-6]}[0]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-6]}[0]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-6]}[0]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]){
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-6]}[0]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0] 
ne $value){
$rootcnt++;
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-6]}[0]->{$path[$path_cnt-5]}[0]->{$path[$path_cnt-4]}[0]->{$path[$path_cnt-3]}[0]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]=$value;
next INFO;
}
}
}
next INFO;
}
##################################

## here we check to see if this table has a parent in the xml output document
my $xpath=$info->{xpath};
if(($xpath =~ /^parent/i)or($xpath =~ m[^\.\./])){
$table_pass{parent}->{$lpcnt}->{value}=$value;
$table_pass{parent}->{$lpcnt}->{xpath}=$info->{xpath};
$table_pass{parent}->{$lpcnt}->{attribute}=$info->{attribute};
$table_pass{parent}->{hasone}="yes";
next INFO;
}
$info->{xpath} =~ s[^\./][];
my @current_xpath=split m[/], $info->{xpath};
my $path_cnt=scalar  @current_xpath;
if($table_node ne $doc_root){
#######################################################
if($path_cnt == 1){
if($table_node ne $info->{item_node}){
if($info->{attribute}){
$table_doc{$current_xpath[0]}[0]->{$info->{attribute}}=$value;
next INFO;
} # end if
if(!$info->{attribute}){
if($value){
$table_doc{$current_xpath[0]}[0]->{content}.=$value;}
next INFO;
}
}
if($table_node eq $info->{item_node}){
if($info->{attribute}){
$table_doc{$info->{attribute}}=$value;
#print $parser->XMLout(\%table_doc, rootname=>$table_node);
next INFO;
} # end if
if(!$info->{attribute}){

$table_doc{content}.=$value;
next INFO;
}
}
} #if $path_cnt==1
#######################################################
if($path_cnt == 2){

if($table_node ne $info->{item_node}){

if($info->{attribute}){
$table_doc{$current_xpath[0]}[0]->{$info->{attribute}}=$value;
next INFO;
} # end if
if(!$info->{attribute}){
$table_doc{$current_xpath[0]}[0]->{$current_xpath[1]}[0]->{content}.=$value;
next INFO;
}
}
if($table_node eq $info->{item_node}){

if($info->{attribute}){
$table_doc{$info->{attribute}}=$value;
next INFO;
}
if(!$info->{attribute}){
$table_doc{$current_xpath[1]}[0]->{content}.=$value;
next INFO;
}
}
} #if $path_cnt==2
#######################################################
if($path_cnt == 3){
if($table_node ne $info->{item_node}){
if($info->{attribute}){
$table_doc{$current_xpath[0]}[0]->{$current_xpath[1]}[0]->{$info->{attribute}}=$value;
next INFO;

DataLoader/XMLWriter.pm  view on Meta::CPAN


} # end if n$table_node ne doc_root



##################################################
##################################################
##################################################
##################################################

if($table_node eq $doc_root){
if($path_cnt == 1){
## if scalar split [/], $info->{xpath} == 1
if($info->{attribute}){
$doc{$doc_root}[$rootcnt]->{$current_xpath[0]}[0]->{$info->{attribute}}=$value;
next INFO;
} # end if
if(!$info->{attribute}){
$doc{$doc_root}[$rootcnt]->{$current_xpath[0]}[0]->{content}.=$value;
next INFO;
}
} #if $path_cnt==1
################################################

#######################################################
if($path_cnt == 2){
if($info->{attribute}){
$doc{$doc_root}[$rootcnt]->{$current_xpath[0]}[0]->{$info->{attribute}}=$value;
next INFO;
} # end if
if(!$info->{attribute}){

$doc{$doc_root}[$rootcnt]->{$current_xpath[0]}[0]->{$current_xpath[1]}[0]->{content}.=$value;
next INFO;
}
} #if $path_cnt==2
################################################


#######################################################
if($path_cnt == 3){
if($info->{attribute}){
$doc{$doc_root}[$rootcnt]->{$current_xpath[0]}[0]->{$current_xpath[1]}[0]->{$info->{attribute}}=$value;
next INFO;
} # end if
if(!$info->{attribute}){
$doc{$doc_root}[$rootcnt]->{$current_xpath[0]}[0]->{$current_xpath[1]}[0]->{$current_xpath[2]}[0]->{content}.=$value;
next INFO;
}
} #if $path_cnt==3
################################################

} # end if $table_node eq doc_root

}  ## end INFO loop
############ here we start to rconstruct the rest of our doc;
if(!%table_doc){next LOOPCNT;}
my $table_data=\%table_doc;

if($table_pass{parent}->{hasone} eq "no"){ 
my @path=split m[/], $table_xpath;
my $path_cnt=scalar @path;
# we have no parent so lets just add the table our doc hash
my $depth=0;

if($path_cnt == 1){

if($doc{$the_root}[$rootcnt]->{$table_node}){$depth=scalar @{$doc{$the_root}[$rootcnt]->{$table_node}};}

$doc{$doc_root}[$rootcnt]->{$table_node}[$depth]=$table_data;
next LOOPCNT;
}
if($path_cnt == 2){
if($doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$table_node}){$depth=scalar @{$doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$table_node}};}

$doc{$doc_root}[$rootcnt]->{$path[0]}[0]->{$table_node}[$depth]=$table_data;
next LOOPCNT;
}

if($path_cnt == 3){
if($doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$table_node}){
$depth=scalar @{$doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$table_node}};}
$doc{$doc_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$table_node}[$depth]=$table_data;
next LOOPCNT;
}
if($path_cnt == 4){
if($doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$table_node}){
$depth=scalar @{$doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$table_node}};}

$doc{$doc_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$table_node}[$lpcnt-1]=$table_data;
next LOOPCNT;
}
if($path_cnt == 5){
if($doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$path[3]}[0]->{$table_node}){
$depth=scalar @{$doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$path[3]}[0]->{$table_node}};}

$doc{$doc_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$path[3]}[0]->{$table_node}[$lpcnt-1]=$table_data;
next LOOPCNT;
}
if($path_cnt == 6){
if($doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$path[3]}[0]->{$path[4]}[0]->{$table_node}){
$depth=scalar @{$doc{$the_root}[$rootcnt]->{$path[0]}[0]->{$path[2]}[0]->{$path[1]}[0]->{$path[3]}[0]->{$path[4]}[0]->{$table_node}};}

$doc{$doc_root}[$rootcnt]->{$path[0]}[0]->{$path[1]}[0]->{$path[2]}[0]->{$path[3]}[0]->{$path[4]}[0]->{$table_node}[$lpcnt-1]=$table_data;
next LOOPCNT;
}



}

## below we try to find a xml segments parents
if($table_pass{parent}->{hasone} eq "yes"){

my $xpath=$table_pass{parent}->{$lpcnt}->{xpath};
my $value=$table_pass{parent}->{$lpcnt}->{value};
my $node_type="content";
if($table_pass{parent}->{$lpcnt}->{attribute}){
$node_type=$table_pass{parent}->{$lpcnt}->{attribute};
}


my @xpath_array=split m[/], $xpath;
my $xpath_node=pop @xpath_array;
my $parent_node=unshift @xpath_array;
$parent_node=~s/parent:://;

# here we check to see if this is a attribute or element content
my $element;
my $attribute;

if($xpath_node !~ /\@/){$element=$xpath_node;}
if($xpath_node =~ /\@/){$attribute=$xpath_node;$attribute =~ s/\@//;}

my @path=split m[/], $table_xpath;
my $table_node=pop @path;
my $path_cnt=scalar @path;

my $p_node_location_cnt;
PNODE: for my $pnode (@path){
$p_node_location_cnt++;
if($pnode eq $parent_node){last PNODE;}
}

if($path_cnt==1){

	if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}){
	my $cnt;
	# here we have a value so we loop through the nodes
		for my $node (@{$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}}){
my $depth=0;
if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[$cnt-1]->{$tableroot}){
$depth=scalar @{$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[$cnt-1]->{$tableroot}};
}

		$cnt++;
		my $node_type;
		if($element){$node_type="content";}
		if($attribute){$node_type=$attribute;}
			if($node->{$node_type} eq $value){
			# 
			# node found;  
			# $doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[$cnt-1]
			## here we go ahead and add our table to this node
			$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[$cnt-1]->{$tableroot}[$depth]=$table_data;
			next LOOPCNT;
			}
		
                ## here we look ahead in the array for a value for the next item
                        if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[$cnt]){
                        $doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[$cnt]->{$node_type}=$value;
                        ## here we add the rest of the table stuff on
                        $doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[$cnt]->{$tableroot}[0]=$table_data;
                                                next LOOPCNT;

                        }
}
	}
if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}){
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[0]->{$node_type}=$value;
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-1]}[0]->{$tableroot}[0]=$table_data;
next LOOPCNT;
}
}  # end if pacth_cnt == 1

if($path_cnt == 2){
if(!$doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}){
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]->{$node_type}=$value;
$doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}[0]->{$tableroot}[0]=$table_data;
next LOOPCNT;
}
	if($doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}){

	my $cnt;
		for my $node (@{$doc{$the_root}[$rootcnt]->{$path[$path_cnt-2]}[0]->{$path[$path_cnt-1]}}){	



( run in 0.762 second using v1.01-cache-2.11-cpan-71847e10f99 )