view release on metacpan or  search on metacpan

mkxmltype  view on Meta::CPAN

our ($latin1,$html,$show_att,$expand_att_id,$class);
our ($lines,$t,$shell);

my (@files)=@ARGV;
@ARGV=();



mkxmltypes (@files);


sub mkxmltypes {
  my %type=();
  my @files = @_;
  my %root = ();
  my %att=();
  my %dom=();

  my %ele=();
  my %elel=();
  my %atl=();
  my %handler=(
#    '-outputenc' => 'ISO-8859-1',
    '-default'   => sub{ 
          $c =~ s/,$//;
          if(not $class){
            push(@{$type{$q}}, (eval("[$c]") || "?$c"));
            $elel{$q}++;
            if(ctxt(1)){ $ele{ctxt(1)}{$q} ++;}
            else       { $root{$q}++}
            for(keys(%v)){
                $atl{$_}++;
                $att{$q}{$_}{tipo($v{$_})||"_str"} ++  ;
                $dom{$q}{$_}{$v{$_}} ++ } 
            "'$q',";
          }
          else{
            my $qcl=$q;
            if($v{class}){$qcl .="+$v{class}"}
            if($v{id}   ){$qcl .="+$v{id}"}
            
            push(@{$type{$qcl}}, (eval("[$c]") || "?$c"));
            $elel{$qcl}++;
            if(ctxt(1)){ 
               my $fcl=ctxt(1);
               if(father->{class}){$fcl .="+".father->{class}}
               if(father->{id}   ){$fcl .="+".father->{id}}
               $ele{$fcl}{$qcl} ++;}
            else       { $root{$qcl}++}

            for(keys(%v)){
                next if ($_ eq "class");
                next if ($_ eq "id");
                $atl{$_}++;
                $att{$qcl}{$_}{tipo($v{$_})||"_str"} ++  ;
                $dom{$qcl}{$_}{$v{$_}} ++ } 
            "'$qcl',";
          }
        },
    '-pcdata'    => sub{ if ($c =~ /[^ \t\n]/){ $ele{ctxt(1)}{"#PCDATA"}=1;
"'#PCDATA'," } else {""}},
  );

  if  ($html) { $handler{'-html'} = 1;} 
  if($latin1) { $handler{'-inputenc'}='ISO-8859-1';}

  for my $fname (@files){
    if($lines){
      my $tmpfile = File::Temp->new( UNLINK => 0 )->filename;
      system("head -$lines $fname | xmllint --recover - > $tmpfile");
      $fname = $tmpfile;
    }
    dt($fname,%handler); 
    unlink($fname) if $lines;
  }

  ###  print "DEBUG",Dumper(\%att,\%ele,\%dom,\%atl);
  print "# ", join(" ",keys %root)," ...",  scalar(localtime(time)) ,"\n";

  my %resumofinal=();
  for (keys %type){
     my @tipo=();
     for my $lista (@{$type{$_}}){ push (@tipo, processa($lista)) }
     $resumofinal{$_}=resumele(processa2([@tipo])).resumeatts($att{$_});
  }

  if($shell){ shell($t,\%root,\%ele,\%att,\%dom,\%resumofinal,\%atl); }
  else{       pprint(\%resumofinal,ordem(\%ele,(($t) ||(keys %root) ))); }
}

sub shell{
    my ($t,$root,$ele,$att,$dom,$resumofinal,$atl) = @_;
    my $last=(keys %$root)[0];
    my $elepat = q{[\w:]+};
    my $max = 10;
    my $term = new Term::ReadLine 'sample';
    my $tas = $term->Attribs;
    $tas->{completion_entry_function}= $tas->{list_completion_function};
    $tas->{completion_word} = [ keys(%$ele), keys(%$atl) ];

    pprint($resumofinal,ordem($ele,(($t) ||(keys %$root) )));
    while ( defined ($_ = $term->readline("\npfs> ")) ) {
      chomp(); 
      $term->addhistory($_) if /\S/;
      s/^\s*(.*?)\s*$/$1/;
      if(/($elepat)\[\@?($elepat)\]/){
         print resumeatt($att->{$1}{$2},$dom->{$1}{$2},$max);
         $last = $1}
      elsif(/\!max\s*=?\s*(\d+)/){$max=$1;}
      elsif(/\.($elepat)/){
         print resumeatt($att->{$last}{$1},$dom->{$last}{$1},$max);}
      elsif(!$_ or defined $ele->{$_}) {
         $last=$_; 
         pprint($resumofinal,ordem($ele,(($_) ||(keys %$root) ))); }
      else{
         for my $e (keys %$att){
           for my $a (keys %{$att->{$e}}){
            print "$e($a):",
                  resumeatt($att->{$e}{$a},$dom->{$e}{$a},$max) if($a eq $_)
           }