view release on metacpan or  search on metacpan

lib/AnyData/Format/XML.pm  view on Meta::CPAN

            my $i;
            for $i(0..scalar @$newc -1) {
  	        my $cur = $newc->[$i]->[0];
#                $cur =~ s"^.*/([^/]+)$"$1";
#print "$cur : ";
  	        my $path = $colh->{ $cur };
                my $p;
  	        if ($path) {
                    $p = $newc->[$i]->[0] = $path . '/' . $newc->[$i]->[0];
            #        delete $colh->{$cur};
                    $nh->{$cur} = $p;
                    $done=0;
	        }
                while (my($k,$v)=each %$nh) {
                   if ( $cur =~ m"^$k/(.*)") {
                      $newc->[$i]->[0] = $v . '/' . $1;
                      $done = 0;
                   }
                }
	    }
	}
        #@array = grep(!$is_member{$_}++, @array);
        my %is_member;
        for my $row (@$newc) {
            my $c = '/' . $row->[0] . '/' . $row->[1];
            push @$col_names, $c if !$is_member{$c};
            $is_member{$c}++;
        }
        # put in order by depth
        @$col_names = sort {
            my $x=$a; 
            my $y=$b; 
            $x =~ s"[^/]""g;; $x=length $x;
            $y =~ s"[^/]""g;; $y=length $y;
           $x <=> $y; 
        } @$col_names;
        $record_tag ||= $col_names->[0];
        $record_tag =~ s".*/([^/]+)$"$1";
 #       $record_tag = $twig->first_elt($record_tag) 
 #                   || die "Can't find column '$record_tag'!". $@;
        #print $record_tag, Dumper $col_names; exit;
        my %done;
	for my $c(@$col_names) {
           my @tags = split '/', $c;
           shift @tags; # remove root
           for my $i(0..$#tags) {
               my $t = $tags[$i];
               next if $done{$c.$t};
               next unless  $c =~ m"/$t$";
#               print "$c:$t\n";
#               next if $done{$t};
               $done{$c.$t}++ ; 
               my $nxt = $twig->root->next_elt($t);
               next if $nxt and $nxt->path =~ /^$c/;
               next if $t eq $twig->root->gi;
               my $p= $tags[$i-1];
               my $pos = $twig->root->next_elt($p);
               $pos ||= $twig->root;
               my $e= new XML::Twig::Elt($t);
               #if ($col_text->{$e->gi.'#PCDATA'}) {
               #     $e->append_pcdata("xxx");
	       #}
               $e->paste('last_child',$pos);
             #  if ($col_text->{$e->gi.'#PCDATA'} ) {
              #      print $e->gi.'#PCDATA'."\n";
                #    $twig->root->next_elt($e->gi)->append_pcdata('x');
	      # }
	   }
	}
        my $atts;
        while (my($k,$v)=each%{$self->{dtd}->{att}}) {
           my $cur = $twig->root->next_elt($k);
           next unless $cur;
               while (my($k2,$v2)=each%{$v}) {
###                   $cur->set_att($k2,"");
                   $atts->{$cur->path.'/'.$k2}=$k2;
#print "[".$cur->path.'/'.$k2."]";
               }
        }
        $record_tag ||= $twig->root->first_child->gi;
        $record_tag = $twig->root->next_elt($record_tag)
                   || die "Couldn't find column '$record_tag'!";
        $newc = [];
        my $found;
        for my $org(@$col_names) {
           my $x = $org;
           $x =~ s".*/([^/]+)$"$1";
           my $p =$record_tag->parent->path;
           next unless $org =~ /^$p/;
           #next unless $p =~ /^$_/;
           while (my($k,$v)=each%$atts) {
             next if $found->{$k};
	     if ( $k =~ m"$p/([^/]+)$" 
               or  $k =~ m"$p/([^/]+/[^/]+)$"
                ) {
#print "$k\n";
               push @$newc, $k;
               $found->{$k}++;
	     }
	   }
           push @$newc, $org if $col_text->{$x.'#PCDATA'}
                           or $col_text->{$x.'#CDATA'};
        }
        #unshift @$newc, $record_tag->gi unless $found;
#die Dumper $newc;
#$twig->print; exit;

        my $elt = $twig->root;
    if (!$self->{recs}) {
        while ( $elt = $elt->next_elt ) {
            $elt->set_att('xstruct__','1');
	}
        $record_tag->set_att('record_tag__','1');
    }
        #########
        # COMMENT THIS TO SEE STRUCTURE TAGS
        #
        $self->{destroy}++;

#print Dumper $record_tag->gi,$newc, $atts;
return( $record_tag,$newc, $atts);
#$twig->print; exit;
}

sub get_structure {
    my $self = shift;