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 )