XML-DT-0.63/000755 000765 000024 00000000000 12124147445 012500 5ustar00ambsstaff000000 000000 XML-DT-0.63/Changes000644 000765 000024 00000013061 12124147173 013772 0ustar00ambsstaff000000 000000 Revision history for Perl extension XML::DT. 0.63 Mar 25, 2013 - mkdtskel now uses strict/warnings 0.62 Jul 25, 2012 - Add the -userdata option. - Document -userdata, -html and -recover. 0.61 Jul 25, 2012 - Handle undef elements when parsing wrong formed XML. 0.60 Jul 25, 2012 - Add -recover option to parse XML (not just HTML). 0.59 Jun 5, 2012 - Fix POD encodings. 0.58 Apr 9, 2012 - Adding missing pre-requisite (parent). 0.57 Apr 7, 2012 - Let CDATA and PCDATA be processed in a different way. 0.56 Feb 12, 2011 - Removed debug message :-/ 0.55 Feb 12, 2011 - Process correctly entities (I think) 0.54 Nov 19, 2010 - require 5.8.6 - minor changes; 0.53 Jan 18, 2009 - added 'inpath' function. 0.52 Oct 22, 2008 - fixed bug on whitepc function. 0.51 Feb 22, 2008 - tohtml function with better handle of specific HTML tags 0.50 Feb 21, 2008 - Fixed a problem with HFS+ extended attributes 0.49 Feb 21, 2008 - Fixed a typo 0.48 Feb 21, 2008 - added tohtml function. Does the same as toxml, but does not create empty tags. - use -tohtml=>1 in a handler to use tohtml instead of toxml 0.47 Nov 23, 2006 - finally, XML::Parser backend was removed. - Added father, gfather, ggfather and root acessing method. 0.46 Nov 3, 2006 - mkdtskel for a HTML adds -html flag - XML::LibXML is used by default. 0.45 May 16, 2006 - Added use strict for XML::Parser backend 0.44 May 15, 2006 - Remove the use of $' and $` which makes regular expressions a lot slower 0.43 May 15, 2006 (bad release) 0.42 Sep 18, 2005 - Added use strict; 0.41 Jul 20, 2005 - Removed warning from HTML parsing; 0.40 Apr 06, 2005 - Added default type directive - Added tests for type-based XML processing; - Fixed recursive toxml; 0.39 Mar 22, 2005 - Added open '-ignorecase' to look to tag names and attributes as the same although they differ in case - toxml creates empty tag if $c equals to "" 0.38 Dec 24, 2004 - MERRY CHRISTMAS - Removed Test::Pod and Test::Pod::Coverage from Makefile.PL - Turned off all validation from XML::LibXML -- this way the DTD does not gets loaded and processing becomes faster 0.37 Nov 21, 2004 - Parse correctly CDATA sections using XML::LibXML; 0.36 Nov 19, 2004 - Added support for bad HTML documents; - Added test for -dtd support of mkdtskel; - Moved mkdtskel code to main module; - Changed default format for mkdtskel; 0.35 Nov 15, 2004 - Added -dtd support to mkdtskel (now we need XML::DTDParser) 0.34 Oct 30, 2004 - corrected '@dtattributes' instead of '@dtatributes' NOTICE: we will keep back compatibility for limited time. - Renamed ID type to THE_CHILD - Created LAST_CHILD type 0.33 Oct 03, 2004 - Added ID type; 0.32 Sep 20, 2004 - Added missing documentation; - Added pod and pod-coverage tests; 0.31 Aug 09, 2004 - Added documentation to @dtattributes 0.30 Jan 22, 2004 - Bugs corrected with encodings in attributes - Corrected encoding with utf8 locale -- we hope :-(; 0.29 Jan 07, 2004 - Corrected bug with encodings. - Added test for dtstring and encoding; 0.28 Dec 16, 2003 - Corrected bug when outputing a data structure. 0.27 Nov 14, 2003 - Added -declr switch. When added, dt will add the - Added global variable $PARSER with info about what parser is being used (XML::Parser or XML::LibXML); - Require a recent ExtUtils::MakeMaker. This will fix the problem with PM_FILTER syntax change (I hope) 0.26 Oct 12, 2003 - Corrected makefile so that it detects if it should use perl 5.8.0 or 5.8.1 PM_FILTER syntax; - Fixed bug with tags with only a '0' inside; 0.25 Oct 08, 2003 - Thanks to Martin Mokrejs, detected too many bugs with perl 5.8.1. 0.24.1 Jun 17, 2003 - corrected problem when using a prefix on Makefile.PL 0.24 Fev 20, 2003 - added documentation to mkdtskel and mkdtdskel; - ispell'ed README, Changes and DT.pm(pod) files; - added ExtUtils::MakeMaker version request; - added tests (basic functions, xpath, string processing); - added code to support html parsing using libxml2 html parser; - added XPath tests; Added 'toxml' tests; - added dturl and pathdturl method; - added mkdtskel -html; - added mkdtskel -dtd (dirty solution); 0.23 Dec 23, 2002 - removed a lot of code on Makefile.PL. Now ExtUtils::MakeMaker takes care of the full task. 0.22 Dec 20, 2002 - added mkdtdskel as an installed script; - added DT.pm as distribution file, for cpan indexing; 0.21 May 27, 2002 - let the user choose between XML::Parser or XML::LibXML; 0.20 Fev 20, 2001 - installs mkdtskel shell script to be used quickly - removed HTML files from package. User can do that with pod2html 0.19 Nov 30, 2000 - better pathdt functions with '//aaa[@att='asdasd']' 0.18 Nov 18, 2000 - Bug fixed in dtd generator function: mkdtdskel - possibility of passing parameters do toxml: toxml(tag, {...attributes...}, contents) - XPath functions to use paths instead of tags; 0.17 Oct 30, 2000 - added a -type => ZERO that don't processes its sub-elements and return "". It is good to avoid visiting certain parts of the document, and for better performance. 0.16 Oct 16, 2000 - problems with the changes on UNICODE - 0.15 does not work with Perl 5.005; Solution: "use bytes" if we find it. eval("use bytes") if ($inc{bytes.pm}) { require and import...} 0.15 Sep 16, 2000 - Corrected bug in pod; - problems with the changes on UNICODE; ... XML-DT-0.63/examples/000755 000765 000024 00000000000 12124147445 014316 5ustar00ambsstaff000000 000000 XML-DT-0.63/lib/000755 000765 000024 00000000000 12124147445 013246 5ustar00ambsstaff000000 000000 XML-DT-0.63/Makefile.PL000644 000765 000024 00000001324 11740533425 014452 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use 5.008006; use ExtUtils::MakeMaker; %req_modules = ( 'ExtUtils::MakeMaker' => '6.17', 'Test::More' => '0.40', 'LWP::Simple' => '1.35', 'XML::DTDParser' => '2.00', 'XML::LibXML' => '1.54', 'parent' => '0', 'Scalar::Util' => '0', ); WriteMakefile( 'NAME' => 'XML::DT', 'VERSION_FROM' => 'lib/XML/DT.pm', 'EXE_FILES' => [ "mkdtskel", "mkdtdskel", "mkxmltype" ], 'PM_FILTER' => $PM_FILTER, 'PREREQ_PM' => \%req_modules, 'LICENSE' => 'perl', ($] >= 5.005 ? (ABSTRACT_FROM => 'lib/XML/DT.pm', AUTHOR => 'Jose Joao ') : () ), ); XML-DT-0.63/MANIFEST000644 000765 000024 00000002427 12124147445 013636 0ustar00ambsstaff000000 000000 Changes MANIFEST Makefile.PL lib/XML/DT.pm README mkdtskel mkdtdskel mkxmltype examples/arq.pl examples/arq.xml examples/ex2.pl examples/ex3.xml examples/ex1.pl examples/ex5.pl examples/ex6.pl examples/ex7.pl examples/ex10.1.pl examples/ex10.2.pl examples/ex10.2.xml examples/ex10.3.xml examples/ex10.3.pl examples/ex11.1.pl examples/ex11.1.xml examples/ex11.5.pl examples/ex11.5.xml examples/ex.xml examples/jj.dtd examples/makefile examples/README examples/lat1.html examples/10nov.sgm examples/pub.pl examples/publico.dtd examples/gcapaper2tex.pl examples/XPath/ex1.pl examples/XPath/ex1.xml examples/XPath/ex2.pl examples/XPath/ex2.xml examples/XPath/ex3.pl examples/XPath/ex3.xml examples/XPath/ex4.pl examples/XPath/ex4.xml examples/XPath/ex5.pl examples/XPath/ex5.xml examples/XPath/ex6.pl examples/XPath/ex6.xml examples/XPath/ex7.pl examples/XPath/ex7.xml examples/XPath/ex8.pl examples/XPath/ex8.xml examples/XPath/ex8.xml examples/makenewexample t/00_basic.t t/50_xpath.t t/05_input.xml t/05_strings.t t/06_mkdtskel.t t/06_output.pl META.yml Module meta-data (added by MakeMaker) t/pod-coverage.t t/pod.t t/06_input.dtd t/06_dtdout.pl t/07_case.t t/07_case.xml t/60_types.t META.json Module JSON meta-data (added by MakeMaker) XML-DT-0.63/META.json000644 000765 000024 00000002114 12124147445 014117 0ustar00ambsstaff000000 000000 { "abstract" : "a package for down translation of XML files", "author" : [ "Jose Joao " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "XML-DT", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "ExtUtils::MakeMaker" : "6.17", "LWP::Simple" : "1.35", "Scalar::Util" : "0", "Test::More" : "0.40", "XML::DTDParser" : "2.00", "XML::LibXML" : "1.54", "parent" : "0" } } }, "release_status" : "stable", "version" : "0.63" } XML-DT-0.63/META.yml000644 000765 000024 00000001150 12124147445 013746 0ustar00ambsstaff000000 000000 --- abstract: 'a package for down translation of XML files' author: - 'Jose Joao ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: XML-DT no_index: directory: - t - inc requires: ExtUtils::MakeMaker: 6.17 LWP::Simple: 1.35 Scalar::Util: 0 Test::More: 0.40 XML::DTDParser: 2.00 XML::LibXML: 1.54 parent: 0 version: 0.63 XML-DT-0.63/mkdtdskel000644 000765 000024 00000001067 11763404720 014411 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT; mkdtdskel (@ARGV) #simple huh? __END__ =encoding utf-8 =head1 NAME mkdtskel - DTD generator using XML::DT =head1 SYNOPSIS mkdttskel =head1 DESCRIPTION This command tries to infer the DTD structure for a specific XML file; =head1 SEE ALSO XML::DT(1), mkdtskel(1) and perl(1) =head1 AUTHORS Jose João Almeida, =head1 COPYRIGHT AND LICENSE Copyright 1999-2004 by Projecto Natura This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut XML-DT-0.63/mkdtskel000644 000765 000024 00000002651 12124146774 014251 0ustar00ambsstaff000000 000000 #!/usr/bin/perl -s use XML::DT; use XML::DTDParser "ParseDTDFile"; our ($dtd, $html, $lines); my $filename = shift; $dtd = 1 if $filename =~ m!\.dtd$!; if ($dtd) { mkdtskel_fromDTD ($filename, @ARGV); } else { if ($lines) { ## XXX - fixme, using head/xmllint is not a good idea system("head -$lines $filename | xmllint --recover - > /tmp/_xml_$$"); $filename = "/tmp/_xml_$$"; } if ($html) { mkdtskel("-html", $filename, @ARGV); } else { mkdtskel($filename, @ARGV); } unlink("/tmp/_xml_$$") if $lines; } __END__ =encoding utf-8 =head1 NAME mkdtskel - Perl code skeleton generator to process XML files with XML::DT =head1 SYNOPSIS mkdtskel [-lines=20000] mkdtskel -dtd mkdtskel -html =head1 DESCRIPTION Use this command to prepare a skeleton file with basic code needed to process your XML file with XML::DT; The command checks the element names and for each one, the attributes. This information is described on the generated file to remember the programmer. =head1 SEE ALSO XML::DT(1), mkdtdskel(1), mkxmltype(1) and perl(1) =head1 AUTHORS Jose Joao Almeida, Alberto Manuel Simões, =head1 COPYRIGHT AND LICENSE Copyright 1999-2013 by Projecto Natura This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut XML-DT-0.63/mkxmltype000755 000765 000024 00000016402 10730327732 014463 0ustar00ambsstaff000000 000000 #!/usr/bin/perl -w -s use XML::DT; use Data::Dumper; use Term::ReadLine; #use locale; use strict; our ($latin1,$html,$show_att,$expand_att_id); 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/,$//; 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',"; }, '-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){ system("head -$lines $fname | xmllint --recover - > /tmp/_xml_$$"); $fname = "/tmp/_xml_$$"; } dt($fname,%handler); unlink("/tmp/_xml_$$") if $lines; } 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 $_) } } } } } sub ordem{ my ($rel,@st)=@_; my @r=(); my %visited = ('#PCDATA' => 1); while(@st){ my $next = shift(@st); next if $visited{$next}; push(@r,$next); $visited{$next} = 1; push(@st, (grep {! $visited{$_}} (keys %{$rel->{$next}}))); } \@r; } sub pprint{ my $r = shift; my $order = shift; for (@$order){ print "$_ \t=> $r->{$_}\n";} } sub resumeatts{ my $a=shift; my $r=""; for (keys(%{$a})) { if($expand_att_id){ $r .= "\n\t\t * $_:(".join(",",keys %{$a->{$_}}) . ")" } else { $r .= " * $_" } } $r } sub resumeatt{ my $a=shift; my $d=shift; my $max = shift(@_) || 10; my $r= join("|",keys %{$a}) ; my @domact = (grep {defined $_} ((keys %{$d}))[0..$max]); $domact[$max] = '...' if $domact[$max]; $r . " = {". join(",",@domact) . "}\n"; } sub processa{ my $a=shift; if( @$a == 0 ) { +{ _isa =>"empty"} } elsif( @$a == 1 && $a->[0] eq '#PCDATA') { +{ _isa =>"text" ,$a->[0] =>[1,1]} } elsif( @$a == 1 ) { +{ _isa =>"singleton",$a->[0] =>[1,1]} } else{ my %f = (); for (@$a){$f{$_}[0]++,$f{$_}[1]++} my $dif = scalar keys %f; if($dif == 1) { +{ _isa =>"seq", %f} ; } elsif($dif == @$a) { +{ _isa =>"tup", %f}; } elsif($f{'#PCDATA'}){ +{ _isa =>"mixed", %f }; } else { +{ _isa =>"mtup", %f } } } } sub processa2{ my $a=shift; if ( @$a == 0 ) { die("no sons????") } elsif( @$a == 1 ) { $a->[0] } else{ my %f = (); my %maybe = (); for (@$a){$f{sons2str($_)}++; $maybe{$_->{_isa}}++ } my $dif = scalar keys %f; if ($dif == 1) { $a->[0]; } elsif($maybe{mixed} || $maybe{text}){ +{%{join_sons($a)}, _isa=> "mixed"} } else { my %s= %{join_sons($a)}; if(keys %s == 1) { +{%s, _isa => "seq"}} else { +{%s, _isa => "mtup"} } } } } sub resumele{ my $a=shift; ## print Dumper($a); my $i = $a->{_isa}; delete $a->{_isa}; if ($i eq "text") {"text"} elsif ($i eq "empty") {"empty"} elsif ($i eq "singleton") {join(", ", keys %{$a}) } elsif ($i eq "mixed") {delete $a->{'#PCDATA'}; if(keys %{$a}){ "mixed(".join(", ", keys %{$a}).")"} else {"text"} } elsif ($i eq "tup") {"tup(".join(", ", keys %{$a}).")"} elsif ($i eq "seq") {"seq(".join(", ", keys %{$a}).")"} else { my $r= "mtup("; for(sort keys %$a){ $r .= "$_, " if ( $a->{$_}[0] == 1 && $a->{$_}[1] == 1 ); $r .= "$_?, " if ( $a->{$_}[0] == 0 && $a->{$_}[1] == 1 ); $r .= "$_*, " if ( $a->{$_}[0] == 0 && $a->{$_}[1] > 1 ); $r .= "$_+, " if ( $a->{$_}[0] > 0 && $a->{$_}[1] > 1 ); $r .= Dumper($a) if($r =~ /\($/ ); } $r =~ s/, $//; $r.=")"; } } sub join_sons{ my $a = shift; my %final = ( map { ($_ => [$a->[0]{$_}[0], $a->[0]{$_}[1]])} grep {$_ ne "_isa"} keys %{$a->[0]}); my %todas=(); for (@$a){ my @novas=keys %{$_}; @todas{@novas}= @novas; for my $k (keys %todas){ next if $k =~ /_isa/; $final{$k}[0]=0 unless $final{$k}[0]; unless (exists $_->{$k}){ $final{$k}[0]=0; next} $final{$k}[1]=$_->{$k}[1] if $_->{$k}[1] > ($final{$k}[1] || 0); $final{$k}[0]=$_->{$k}[0] if $_->{$k}[0] < $final{$k}[0]; } } \%final } sub sons2str{ my $a = shift; join(' ',($a->{_isa},map { $_ . ($a->{$_}[0]==1 ? "" : "+") } grep {$_ ne "_isa"} sort keys %$a)); } sub tipo{ my $a=shift; for ($a){ if(/^\s*\d+\s*$/) {return "_int" } elsif(m{^\s*(https?|ftp|file)://\w[~&=?\w:/.-]+\s*$}i){return "_url" } elsif(/^\s*\d+\.\d+\s*$/) {return "_real" } elsif(/^\w+$/) {return "_id" } elsif(m{^\s*[\w.-]+\@\w[\w_:/.-]+\s*$}) {return "_email" } else {return undef } } } __END__ =head1 NAME mkxmltype - Make XML analysis using XML::DT =head1 SYNOPSIS mkxmltype =head1 DESCRIPTION This command tries to infer DTD and Camlila-like types for a specific XML file; =head1 Options -latin1 input file encoding is forced to be latin1 -html uses html (libxml2) parser -show_att Show attribute values -expand_att_id -lines=20000 just reads the first 20000 lines of the XML file -t -shell Enter interactive shell mode =head1 SEE ALSO XML::DT(1), mkdtskel(1), mkdtdskel and perl(1) =cut XML-DT-0.63/README000644 000765 000024 00000020150 10730327732 013356 0ustar00ambsstaff000000 000000 =head1 XML::DT a Perl XML down translate module With XML::DT, I think that: . it is simple to do simple XML processing tasks :) . it is simple to have the XML processor stored in a single variable (see example 4) . it is simple to translate XML -> Perl user controlled complex structure with a compact "-type" definition (see last section) Feedback welcome -> jj@di.uminho.pt =head1 XML::DT a Perl XML down translate module This document is also available in HTML (pod2html'ized): http://www.di.uminho.pt/~jj/perl/XML/XML-DT.readme.html . design to do simple and compact translation/processing of XML document . it includes some features of omnimark and sgmls.pm; functional approach . it includes functions to automatic build user controlled complex Perl structures (see "working with structures" section) . it was build to show my NLP Perl students that it is easy to work with XML . home page and download: http://www.di.uminho.pt/~jj/perl/XML/DT.html =head1 HOW IT WORKS: . the user must define a handler and call the basic function : dt($filename,%handler) or dtstring($string,%handler) . the handler is a HASH mapping element names to functions. Handlers can have a "-default" function , and a "-end" function . in order to make it smaller each function receives 3 args as global variables $c - contents $q - element name %v - attribute values . the default "-default" function is the identity. The function "toxml" makes the original XML text based on $c, $q and %v values. . see some advanced features in the last examples =head1 SOME simple (naive) examples: INDEX: 1. change to lowercase attribute named "a" in element "e" 2. better solution 3. make some statistics and output results in HTML (using side effects) 4. In a HTML like XML document, substitute ... by the real table of contents (a dirty solution...) 5. a more realistic example: from XML gcapaper DTD to latex WORKING WITH STRUCTURES INSTEAD OF STRINGS... 6. Build the natural Perl structure of the following document (ARRAY,HASH) 7. Multi map on... =head2 1. change to lowercase the contents of the attribute named "a" in element "e" use XML::DT ; my $filename = shift; print dt($filename, ( e => sub{ "$c" })); =head2 2. A better solution of the previous example Ex.1 wouldn't work if we have more attributes in element e. A better solution is print dt($filename, ( e => sub{ $v{a} = lc($v{a}); toxml();})); =head2 3. make some statistics and output results in HTML (using side effects) use XML::DT ; my $filename = shift; %handler=( -default => sub{$elem_counter++; $elem_table{$q}++;"";} # $q -> element name ); dt($filename,%handler); print "

We have found $elem_counter elements in document

"; print "
ELEMENTOCCURS\n"; foreach $elem (sort keys %elem_table) {print "
$elem$elem_table{$elem}\n";} print "
"; =head2 4. In a HTML like XML document, substitute ... by the real table of contents (a dirty solution...) %handler=( h1 => sub{ $index .= "\n$c"; toxml();}, h2 => sub{ $index .= "\n\t$c"; toxml();}, h3 => sub{ $index .= "\n\t\t$c"; toxml();}, contents => sub{ $c="__CLEAN__"; toxml();}, -end => sub{ $c =~ s/__CLEAN__/$index/; $c}); print dt($filename,%handler) =head2 5. a more realistic example: from XML gcapaper DTD to latex notes: . "TITLE" is processed in context dependent way! . output in ISOLATIN1 (this is dirty but my LaTeX doesn't support UNICODE) . a stack of authors was necessary because LaTeX structure was different from input structure... . this example was partially created by the function mkdtskel Perl -MXML::DT -e 'mkdtskel "f.xml"' > f.pl and took me about one hour to tune to real LaTeX/XML example. NAME gcapaper2tex.pl - a Perl script to translate XML gcapaper DTD to latex SYNOPSIS gcapaper2tex.pl mypaper.xml > mupaper.tex use XML::DT ; my $filename = shift; my $beginLatex = '\documentclass{article} \begin{document} '; my $endLatex = '\end{document}'; %handler=( '-outputenc' => 'ISO-8859-1', '-default' => sub{"$c"}, 'RANDLIST' => sub{"\\begin{itemize}$c\\end{itemize}"}, 'AFFIL' => sub{""}, # delete affiliation 'TITLE' => sub{ if(inctxt('SECTION')){"\\section{$c}"} elsif(inctxt('SUBSEC1')){"\\subsection{$c}"} else {"\\title{$c}"} }, 'GCAPAPER' => sub{"$beginLatex $c $endLatex"}, 'PARA' => sub{"$c\n\n"}, 'ADDRESS' => sub{"\\thanks{$c}"}, 'PUB' => sub{"} $c"}, 'EMAIL' => sub{"(\\texttt{$c}) "}, 'FRONT' => sub{"$c\n"}, 'AUTHOR' => sub{ push @aut, $c ; ""}, 'ABSTRACT' => sub{ sprintf('\author{%s}\maketitle\begin{abstract}%s\end{abstract}', join ('\and', @aut) , $c) }, 'CODE.BLOCK' => sub{"\\begin{verbatim}\n$c\\end{verbatim}\n"}, 'XREF' => sub{"\\cite{$v{REFLOC}}"}, 'LI' => sub{"\\item $c"}, 'BIBLIOG' =>sub{"\\begin{thebibliography}{1}$c\\end{thebibliography}\n"}, 'HIGHLIGHT' => sub{" \\emph{$c} "}, 'BIO' => sub{""}, #delete biography 'SURNAME' => sub{" $c "}, 'CODE' => sub{"\\verb!$c!"}, 'BIBITEM' => sub{"\n\\bibitem{$c"}, ); print dt($filename,%handler); =head1 WORKING WITH STRUCTURES INSTEAD OF STRINGS... the "-type" definition defines the way to build structures in each case: . "HASH" or "MAP" -> make an hash with the sub-elements; keys are the sub-element names; warn on repetitions; returns the hash reference. . "ARRAY" or "SEQ" -> make an ARRAY with the sub-elements returns an array reference. . "MULTIMAP" -> makes an HASH of ARRAY; keys are the sub-element . MMAPON(name1, ...) -> similar to HASH but accepts repetitions of the sub-elements "name1"... (and makes an array with them) . STR ->(DEFAULT) concatenates all the sub-elements returned values all the sub-element should return strings to be concatenated =head2 6. Build the natural Perl structure of the following document U.M. University of Minho 1111 1112 1113 Portugal J.Joao; J.Rocha; J.Ramalho use XML::DT; %handler = ( -default => sub{$c}, -type => { institution => 'HASH', tels => 'ARRAY' }, contacts => sub{ [ split(";",$c)] }, ); $a = dt("ex10.2.xml", %handler); $a is a reference to an HASH: { 'tels' => [ 1111, 1112, 1113 ], 'name' => 'University of Minho', 'where' => 'Portugal', 'id' => 'U.M.', 'contacts' => [ 'J.Joao', ' J.Rocha', ' J.Ramalho' ] }; =head2 7. Christmas card... We have the following address book: name0
address00
address01
name1
address10
address11
Now we are going to build a structure to store the address book and write a Christmas card to the first address of everyone #!/usr/bin/perl use XML::DT; %handler = ( -default => sub{$c}, person => sub{ mkchristmascard($c); $c}, -type => { people => 'ARRAY', person => MMAPON('address')}); $people = dt("ex11.1.xml", %handler); print $people->[0]{address}[1]; # prints address01 sub mkchristmascard{ my $x=shift; open(A,"|lpr") or die; print A <<"."; $x->{name} $x->{address}[0] Dear $x->{name} Merry Christmas from Braga Perl mongers\n . close A; } XML-DT-0.63/t/000755 000765 000024 00000000000 12124147445 012743 5ustar00ambsstaff000000 000000 XML-DT-0.63/t/00_basic.t000644 000765 000024 00000007231 10760345620 014512 0ustar00ambsstaff000000 000000 # -*- cperl -*- use Test::More tests => 27; BEGIN { use_ok( 'XML::DT' ); } # normalize_space is(XML::DT::_normalize_space(" teste "), "teste"); is(XML::DT::_normalize_space("\tteste\t"), "teste"); is(XML::DT::_normalize_space("\tteste "), "teste"); is(XML::DT::_normalize_space(" spaces in \t the middle\t"), "spaces in the middle"); # toxml as function is(toxml("a",{},""), ""); is(tohtml("a",{},""), ""); is(tohtml("br",{},""), "
"); is(tohtml("hr",{},""), "
"); is(tohtml("link",{type=>"bar"},""), ""); is(tohtml("img",{src=>"foo"},""), ""); is(toxml("a",{},"c"), "c"); is(tohtml("a",{},"c"), "c"); is(toxml("a",{a=>1},"c"), "c"); is(tohtml("a",{a=>1},"c"), "c"); is(toxml({ -q => "html", -c => { -q => "head", -c => { -q => "title", -c => "Titulo da pagina" }}}), "Titulo da pagina"); is(tohtml({ -q => "html", -c => { -q => "head", -c => { -q => "title", -c => "Titulo da pagina" }}}), "Titulo da pagina"); is(toxml({ -q => "html", -c => { -q => "head", -c => [] } }), ""); is(tohtml({ -q => "html", -c => { -q => "head", -c => [] } }), ""); is(toxml({ -q => "html", -c => { -q => "head", -c => [ { -q => "title", -c => "Titulo da pagina" }, { -q => "title", -c => "Titulo da pagina" }]}}), "Titulo da pagina\nTitulo da pagina"); is(tohtml({ -q => "html", -c => { -q => "head", -c => [ { -q => "title", -c => "Titulo da pagina" }, { -q => "title", -c => "Titulo da pagina" }]}}), "Titulo da pagina\nTitulo da pagina"); is(toxml({ -q => "html", -c => [ { -q => "head", -c => [ { -q => "title", -c => "Titulo da pagina" }, { -q => "title", -c => "Titulo da pagina" }]}, { -q => "head", -c => [ { -q => "title", -c => "Titulo da pagina" }, { -q => "title", -c => "Titulo da pagina" }]}]}), "Titulo da pagina\nTitulo da pagina\nTitulo da pagina\nTitulo da pagina"); is(tohtml({ -q => "html", -c => [ { -q => "head", -c => [ { -q => "title", -c => "Titulo da pagina" }, { -q => "title", -c => "Titulo da pagina" }]}, { -q => "head", -c => [ { -q => "title", -c => "Titulo da pagina" }, { -q => "title", -c => "Titulo da pagina" }]}]}), "Titulo da pagina\nTitulo da pagina\nTitulo da pagina\nTitulo da pagina"); # this is one of the most important tests for MathML is(toxml("foo",{},"0"), "0"); # toxml with variables $q = "a"; $c = "b"; %v = (); is(toxml, "b"); $v{foo} = "bar"; is(toxml, "b"); $c = '0'; is(toxml, "0"); XML-DT-0.63/t/05_input.xml000644 000765 000024 00000000261 10730327732 015127 0ustar00ambsstaff000000 000000 aeiou aeiou aeiou aeiou aeiou aeiou XML-DT-0.63/t/05_strings.t000644 000765 000024 00000002636 10730327732 015134 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; use Test::More tests => 8; my $filename = "t/05_input.xml"; #### %h1=('-default' => sub{"<$q>"}); $str = dt($filename,%h1); $str =~ s/\s//g; is($str, ""); #### %h2=('c' => sub{ "<$q>" }, '-default' => sub{"<$q>$c"}); $str = dt($filename,%h2); $str =~ s/\s//g; is($str, ""); #### %h3=('-default' => sub{"$q:$c"}); $str = dt($filename,%h3); $str =~ s/\s//g; is($str, "a:b:c:aeiouc:aeioub:c:aeiouc:aeioub:c:aeiouc:aeiou"); #### %h4=(c => sub{ $v{title} }, '-default' => sub{ $v{title} ||=""; "$v{title}$c" }); $str = dt($filename,%h4); $str =~ s/\s//g; is($str, "zbrzbr"); ### # Isto não é portável!!!!! # # %h5=(-default=>sub{toxml}); # $str = dt($filename, %h5); # is(`tail -14 t/05_input.xml`,$str); ### $str = dtstring("", -declr => 1); is("\n",$str); ### { no utf8; # use Encode; # for my $straux ("áéíóú", # qq{áéíç}) { # $str = dtstring($straux, -inputenc=>'ISO-8859-1'); # is(decode("iso-8859-1",$str),$straux); # } ### for my $straux ("áéíóú", qq{áéíóú}, "çÇãÃ") { $str = dtstring($straux, -outputenc=>'ISO-8859-1', -inputenc=>'ISO-8859-1'); is($str,$straux); } } XML-DT-0.63/t/06_dtdout.pl000644 000765 000024 00000000645 12124147356 015116 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use XML::DT; my $filename = shift; # Variable Reference # # $c - contents after child processing # $q - element name (tag) # %v - hash of attributes my %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, 'a' => sub { }, 'b' => sub { }, # attributes: title 'c' => sub { }, # attributes: title ); print dt($filename, %handler); XML-DT-0.63/t/06_input.dtd000644 000765 000024 00000000204 10730327732 015100 0ustar00ambsstaff000000 000000 XML-DT-0.63/t/06_mkdtskel.t000644 000765 000024 00000001337 10730327732 015257 0ustar00ambsstaff000000 000000 #-*- cperl -*- use Test::More tests => 2; use XML::DT; { open TMP, ">_${$}_" or die "Cannot create temporary file\n"; select TMP; mkdtskel("t/05_input.xml"); close TMP; open A, "_${$}_"; open B, "t/06_output.pl"; my $ok = 1; while(defined($a = ) && defined($b = )) { $ok = 0 unless $a eq $b; } close B; close A; ok($ok); unlink "_${$}_"; } ###----------------- { open TMP, ">_${$}_" or die "Cannot create temporary file\n"; select TMP; mkdtskel_fromDTD("t/06_input.dtd"); close TMP; open A, "_${$}_"; open B, "t/06_dtdout.pl"; my $ok = 1; while(defined($a = ) && defined($b = )) { $ok = 0 unless $a eq $b; } close B; close A; ok($ok); unlink "_${$}_"; } XML-DT-0.63/t/06_output.pl000644 000765 000024 00000000720 12124147314 015137 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT; use warnings; use strict; my $filename = shift; # Variable Reference # # $c - contents after child processing # $q - element name (tag) # %v - hash of attributes my %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, 'a' => sub{ }, # 1 occurrences; 'b' => sub{ }, # 3 occurrences; attributes: title 'c' => sub{ }, # 6 occurrences; attributes: title ); print dt($filename, %handler); XML-DT-0.63/t/07_case.t000644 000765 000024 00000002657 10730327732 014363 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; use Test::More tests => 8; my $filename = "t/07_case.xml"; #### %h1=('-default' => sub{"<$q>"}); $str = dt($filename,%h1); $str =~ s/\s//g; is($str, ""); %h1=('-ignorecase' => 1, '-default' => sub{"<$q>"}); $str = dt($filename,%h1); $str =~ s/\s//g; is($str, ""); #### %h2=('c' => sub{ "<$q>" }, '-default' => sub{"<$q>$c"}); $str = dt($filename,%h2); $str =~ s/\s//g; is($str, "aeiou"); %h2=('c' => sub{ "<$q>" }, '-ignorecase' => 1, '-default' => sub{"<$q>$c"}); $str = dt($filename,%h2); $str =~ s/\s//g; is($str, ""); #### %h3=('-ignorecase' => 1, '-default' => sub{"$q:$c"}); $str = dt($filename,%h3); $str =~ s/\s//g; is($str, "a:b:c:aeiouc:aeioub:c:aeiouc:aeioub:c:aeiouc:aeiou"); %h3=('-default' => sub{"$q:$c"}); $str = dt($filename,%h3); $str =~ s/\s//g; is($str, "A:b:c:aeiouc:aeioub:C:aeiouc:aeioub:c:aeiouc:aeiou"); #### %h4=('-ignorecase' => 1, c => sub{ $v{title} }, '-default' => sub{ $v{title} ||=""; "$v{title}$c" }); $str = dt($filename,%h4); $str =~ s/\s//g; is($str, "zbrzbr"); %h4=(c => sub{ $v{title} }, '-default' => sub{ $v{title} ||=""; "$v{title}$c" }); $str = dt($filename,%h4); $str =~ s/\s//g; is($str, "zbraeiou"); XML-DT-0.63/t/07_case.xml000644 000765 000024 00000000261 10730327732 014705 0ustar00ambsstaff000000 000000 aeiou aeiou aeiou aeiou aeiou aeiou XML-DT-0.63/t/50_xpath.t000644 000765 000024 00000002427 10730327732 014565 0ustar00ambsstaff000000 000000 # -*- cperl -*- use Test::More tests => 12; use XML::DT; ### XPath over elements my $xml = <<"EOX"; 123 EOX # identity 1 is (pathdtstring($xml, (-default => sub{toxml} ))."\n", $xml); # identity 2 is (pathdtstring($xml, ("//*" => sub{toxml} ))."\n", $xml); is (pathdtstring($xml, ("//c" => sub{"$c"}, -default => sub{toxml})), "123"); is (pathdtstring($xml, ("/c" => sub{"$c"}, "-default" => sub{toxml}))."\n", $xml); is (pathdtstring($xml, ("/*/*/c" => sub{"$c"}, "-default" => sub{toxml})), "123"); is (pathdtstring($xml, ("/*" => sub{"$q"})), "a"); is (pathdtstring($xml, ("a|b|c" => sub{toxml} ))."\n", $xml); ### XPath over attributes $xml = <<"EOX"; 234 EOX #identity 1 is (pathdtstring($xml, (-default => sub{toxml} ))."\n", $xml); #identity 2 is (pathdtstring($xml, ("//*" => sub{toxml} ))."\n", $xml); is (pathdtstring($xml, ("//*[@*]" => sub{toxml($q,{},$c)})), "234"); is (pathdtstring($xml, ("//a[\@v='2']" => sub{toxml($q,{},$c)}, "//*" => sub{toxml})), "234"); is (pathdtstring($xml, ("//a[\@v='1']" => sub{"zbr"})), "zbr"); XML-DT-0.63/t/60_types.t000644 000765 000024 00000001340 10730327732 014577 0ustar00ambsstaff000000 000000 # -*- cperl -*- use Test::More tests => 5; use Data::Dumper; BEGIN { use_ok( 'XML::DT' ); } my $XML = < foofoofoo EOX like(dtstring($XML, -default => sub { $c }, -type => {bar=>'SEQ'} ), qr/fooARRAY\(0x[0-9a-f]+\)foo/); is_deeply(dtstring($XML, -default => sub { $c }, -type => {bar=>'SEQ', -default=>'SEQ'} ), ['foo',['foo'],'foo']); is_deeply(dtstring($XML, -default => sub { $c }, -type => {-default=>'SEQ'} ), ['foo',['foo'],'foo']); is(toxml(dtstring($XML, -default => sub { $c }, -type => {-default=>'SEQH'})), "foo\nfoo\nfoo"); # yeah, we lose the xml tag. XML-DT-0.63/t/pod-coverage.t000644 000765 000024 00000000242 10730327732 015501 0ustar00ambsstaff000000 000000 use Test::More; eval "use Test::Pod::Coverage 0.08"; plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@; all_pod_coverage_ok(); XML-DT-0.63/t/pod.t000644 000765 000024 00000000202 10730327732 013704 0ustar00ambsstaff000000 000000 use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); XML-DT-0.63/lib/XML/000755 000765 000024 00000000000 12124147445 013706 5ustar00ambsstaff000000 000000 XML-DT-0.63/lib/XML/DT.pm000644 000765 000024 00000101575 12124147277 014567 0ustar00ambsstaff000000 000000 ## -*- cperl -*- package XML::DT; use 5.008006; use strict; use Data::Dumper; use LWP::Simple; use XML::DTDParser "ParseDTDFile"; use XML::LibXML ':libxml'; our $PARSER = 'XML::LibXML'; use parent 'Exporter'; use vars qw($c $u %v $q @dtcontext %dtcontextcount @dtatributes @dtattributes ); our @EXPORT = qw(&dt &dtstring &dturl &inctxt &ctxt &mkdtskel &inpath &mkdtskel_fromDTD &mkdtdskel &tohtml &toxml &MMAPON $c %v $q $u &xmltree &pathdturl @dtcontext %dtcontextcount @dtatributes @dtattributes &pathdt &pathdtstring &father &gfather &ggfather &root); our $VERSION = '0.63'; =encoding utf-8 =head1 NAME XML::DT - a package for down translation of XML files =head1 SYNOPSIS use XML::DT; %xml=( 'music' => sub{"Music from: $c\n"}, 'lyrics' => sub{"Lyrics from: $v{name}\n"}, 'title' => sub{ uc($c) }, '-userdata => { something => 'I like' }, '-default' => sub{"$q:$c"} ); print dt($filename,%xml); =head1 ABSTRACT This module is a XML down processor. It maps tag (element) names to functions to process that element and respective contents. =head1 DESCRIPTION This module processes XML files with an approach similar to OMNIMARK. As XML parser it uses XML::LibXML module in an independent way. You can parse HTML files as if they were XML files. For this, you must supply an extra option to the hash: %hander = ( -html => 1, ... ); You can also ask the parser to recover from XML errors: %hander = ( -recover => 1, ... ); =head1 Functions =head2 dt Down translation function C
receives a filename and a set of expressions (functions) defining the processing and associated values for each element. =head2 dtstring C works in a similar way with C
but takes input from a string instead of a file. =head2 dturl C works in a similar way with C
but takes input from an Internet url instead of a file. =head2 pathdt The C function is a C
function which can handle a subset of XPath on handler keys. Example: %handler = ( "article/title" => sub{ toxml("h1",{},$c) }, "section/title" => sub{ toxml("h2",{},$c) }, "title" => sub{ $c }, "//image[@type='jpg']" => sub{ "JPEG: " }, "//image[@type='bmp']" => sub{ "BMP: sorry, no bitmaps on the web" }, ) pathdt($filename, %handler); Here are some examples of valid XPath expressions under XML::DT: /aaa /aaa/bbb //ccc - ccc somewhere (same as "ccc") /*/aaa/* //* - same as "-default" /aaa[@id] - aaa with an attribute id /*[@*] - root with an attribute /aaa[not(@name)] - aaa with no attribute "name" //bbb[@name='foo'] - ... attribute "name" = "foo" /ccc[normalize-space(@name)='bbb'] //*[name()='bbb'] - complex way of saying "//bbb" //*[starts-with(name(),'aa')] - an element named "aa.*" //*[contains(name(),'c')] - an element ".*c.*" //aaa[string-length(name())=4] "...." //aaa[string-length(name())<4] ".{1,4}" //aaa[string-length(name())>5] ".{5,}" Note that not all XPath is currently handled by XML::DT. A lot of XPath will never be added to XML::DT because is not in accordance with the down translation model. For more documentation about XPath check the specification at http://www.w3c.org or some tutorials under http://www.zvon.org =head2 pathdtstring Like the C function but supporting XPath. =head2 pathdturl Like the C function but supporting XPath. =head2 ctxt Returns the context element of the currently being processed element. So, if you call C you will get your father element, and so on. =head2 inpath C is true if the actual element path matches the provided pattern. This function is meant to be used in the element functions in order to achieve context dependent processing. =head2 inctxt C is true if the actual element father matches the provided pattern. =head2 toxml This is the default "-default" function. It can be used to generate XML based on C<$c> C<$q> and C<%v> variables. Example: add a new attribute to element C without changing it: %handler=( ... ele1 => sub { $v{at1} = "v1"; toxml(); }, ) C can also be used with 3 arguments: tag, attributes and contents toxml("a",{href=> "http://local/f.html"}, "example") returns: example Empty tags are written as empty tags. If you want an empty tag with opening and closing tags, then use the C. =head2 tohtml See C. =head2 xmltree This simple function just makes a HASH reference: { -c => $c, -q => $q, all_the_other_attributes } The function C understands this structure and makes XML with it. =head2 mkdtskel Used by the mkdtskel script to generate automatically a XML::DT perl script file based on an XML file. Check C manpage for details. =head2 mkdtskel_fromDTD Used by the mkdtskel script to generate automatically a XML::DT perl script file based on an DTD file. Check C manpage for details. =head2 mkdtdskel Used by the mkdtskel script to generate automatically a XML::DT perl script file based on a DTD file. Check C manpage for details. =head1 Accessing parents With XML::DT you can access an element parent (or grand-parent) attributes, till the root of the XML document. If you use c<$dtattributes[1]{foo} = 'bar'> on a processing function, you are defining the attribute C for that element parent. In the same way, you can use C<$dtattributes[2]> to access the grand-parent. C<$dtattributes[-1]> is, as expected, the XML document root element. There are some shortcuts: =over 4 =item C =item C =item C You can use these functions to access to your C, grand-father (C) or great-grand-father (C): father("x"); # returns value for attribute "x" on father element father("x", "value"); # sets value for attribute "x" on father # element You can also use it directly as a reference to C<@dtattributes>: father->{"x"}; # gets the attribute father->{"x"} = "value"; # sets the attribute $attributes = father; # gets all attributes reference =item C You can use it as a function to access to your tree root element. root("x"); # gets attribute C on root element root("x", "value"); # sets value for attribute C on root You can also use it directly as a reference to C<$dtattributes[-1]>: root->{"x"}; # gets the attribute x root->{"x"} = "value"; # sets the attribute x $attributes = root; # gets all attributes reference =back =head1 User provided element processing functions The user must provide an HASH with a function for each element, that computes element output. Functions can use the element name C<$q>, the element content C<$c> and the attribute values hash C<%v>. All those global variables are defined in C<$CALLER::>. Each time an element is find the associated function is called. Content is calculated by concatenation of element contents strings and interior elements return values. =head2 C<-default> function When a element has no associated function, the function associated with C<-default> called. If no C<-default> function is defined the default function returns a XML like string for the element. When you use C definitions, you often need do set C<-default> function to return just the contents: C. =head2 C<-outputenc> option C<-outputenc> defines the output encoding (default is Unicode UTF8). =head2 C<-inputenc> option C<-inputenc> forces a input encoding type. Whenever that is possible, define the input encoding in the XML file: =head2 C<-pcdata> function C<-pcdata> function is used to define transformation over the contents. Typically this function should look at context (see C function) The default C<-pcdata> function is the identity =head2 C<-cdata> function You can process C<> in a way different from pcdata. If you define a C<-cdata> method, it will be used. Otherwise, the C<-pcdata> method is called. =head2 C<-begin> function Function to be executed before processing XML file. Example of use: initialization of side-effect variables =head2 C<-end> function Function to be executed after processing XML file. I can use C<$c> content value. The value returned by C<-end> will be the C
return value. Example of use: post-processing of returned contents =head2 C<-recover> option If set, the parser will try to recover in XML errors. =head2 C<-html> option If set, the parser will try to recover in errors. Note that this differs from the previous one in the sense it uses some knowledge of the HTML structure for the recovery. =head2 C<-userdata> option Use this to pass any information you like to your handlers. The data structure you pass in this option will be available as C<< $u >> in your code. -- New in 0.62. =head1 Elements with values other than strings (C<-type>) By default all elements return strings, and contents (C<$c>) is the concatenation of the strings returned by the sub-elements. In some situations the XML text contains values that are better processed as a structured type. The following types (functors) are available: =over 4 =item THE_CHILD Return the result of processing the only child of the element. =item LAST_CHILD Returns the result of processing the last child of the element. =item STR concatenates all the sub-elements returned values (DEFAULT) all the sub-element should return strings to be concatenated; =item SEQ makes an ARRAY with all the sub elements contents; attributes are ignored (they should be processed in the sub-element). (returns a ref) If you have different types of sub-elements, you should use SEQH =item SEQH makes an ARRAY of HASH with all the sub elements (returns a ref); for each sub-element: -q => element name -c => contents at1 => at value1 for each attribute =item MAP makes an HASH with the sub elements; keys are the sub-element names, values are their contents. Attributes are ignored. (they should be processed in the sub-element) (returns a ref) =item MULTIMAP makes an HASH of ARRAY; keys are the sub-element names; values are lists of contents; attributes are ignored (they should be processed in the sub-element); (returns a ref) =item MMAPON(element-list) makes an HASH with the sub-elements; keys are the sub-element names, values are their contents; attributes are ignored (they should be processed in the sub-element); for all the elements contained in the element-list, it is created an ARRAY with their contents. (returns a ref) =item XML return a reference to an HASH with: -q => element name -c => contents at1 => at value1 for each attribute =item ZERO don't process the sub-elements; return "" =back When you use C definitions, you often need do set C<-default> function returning just the contents C. =head2 An example: use XML::DT; %handler = ( contacts => sub{ [ split(";",$c)] }, -default => sub{$c}, -type => { institution => 'MAP', degrees => MMAPON('name') tels => 'SEQ' } ); $a = dt ("f.xml", %handler); with the following f.xml U.M. University of Minho 1111 1112 1113 Portugal J.Joao; J.Rocha; J.Ramalho Computer science Informatica history would make $a { 'name' => [ 'Computer science', 'Informatica ', ' history ' ], 'institution' => { 'tels' => [ 1111, 1112, 1113 ], 'name' => 'University of Minho', 'where' => 'Portugal', 'id' => 'U.M.', 'contacts' => [ 'J.Joao', ' J.Rocha', ' J.Ramalho' ] } }; =head1 DT Skeleton generation It is possible to build an initial processor program based on an example To do this use the function C. Example: perl -MXML::DT -e 'mkdtskel "f.xml"' > f.pl =head1 DTD skeleton generation It makes a naive DTD based on an example(s). To do this use the function C. Example: perl -MXML::DT -e 'mkdtdskel "f.xml"' > f.dtd =head1 SEE ALSO mkdtskel(1) and mkdtdskel(1) =head1 AUTHORS Home for XML::DT; http://natura.di.uminho.pt/~jj/perl/XML/ Jose Joao Almeida, Alberto Manuel Simões, =head1 ACKNOWLEDGEMENTS Michel Rodriguez José Carlos Ramalho Mark A. Hillebrand =head1 COPYRIGHT AND LICENSE Copyright 1999-2012 Project Natura. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut our %ty = (); sub dt { my ($file, %xml)=@_; my ($parser, $tree); # Treat -decl option my $declr = ""; if ($xml{-declr}) { if ($xml{-outputenc}) { $declr = "\n"; } else { $declr = "\n"; } } %ty = (); %ty = (%{$xml{'-type'}}) if defined($xml{'-type'}); $ty{-ROOT} = "NONE"; &{$xml{-begin}} if $xml{-begin}; # TODO --- how to force encoding with XML::LibXML? # $xml{-inputenc} # create a new LibXML parser $parser = XML::LibXML->new(); #### We don't wan't DT to load everytime the DTD (I Think!) $parser->validation(0); # $parser->expand_xinclude(0); # testing $parser->load_ext_dtd(0); $parser->expand_entities(0); $parser->expand_xincludes(1) if $xml{'-xinclude'}; # parse the file my $doc; if ( $xml{'-recover'}) { $parser->recover(1); eval { local $SIG{__WARN__} = sub{}; $doc = $parser->parse_file($file); }; return undef if !$doc; } elsif ( $xml{'-html'}) { $parser->recover(1); eval { local $SIG{__WARN__} = sub{}; $doc = $parser->parse_html_file($file); }; return undef if !$doc; } else { $doc = $parser->parse_file($file) } # get the document root element $tree = $doc->getDocumentElement(); my $return = ""; # execute End action if it exists if($xml{-end}) { $c = _omni("-ROOT", \%xml, $tree); $return = &{$xml{-end}} } else { $return = _omni("-ROOT",\%xml, $tree) } if ($declr) { return $declr.$return; } else { return $return; } } sub ctxt { my $level = $_[0]; $dtcontext[-$level-1]; } sub inpath { my $pattern = shift ; join ("/", @dtcontext) =~ m!\b$pattern\b!; } sub inctxt { my $pattern = shift ; # see if is in root context... return 1 if (($pattern eq "^" && @dtcontext==1) || $pattern eq ".*"); join("/", @dtcontext) =~ m!$pattern/[^/]*$! ; } sub father { my ($a,$b)=@_; if (defined($b)){$dtattributes[1]{$a} = $b} elsif(defined($a)){$dtattributes[1]{$a} } else {$dtattributes[1]} } sub gfather { my ($a,$b)=@_; if (defined($b)){$dtattributes[2]{$a} = $b} elsif(defined($a)){$dtattributes[2]{$a} } else {$dtattributes[2]} } sub ggfather { my ($a,$b)=@_; if (defined($b)){$dtattributes[3]{$a} = $b} elsif(defined($a)){$dtattributes[3]{$a} } else {$dtattributes[3]} } sub root { ### the root my ($a,$b)=@_; if (defined($b)){$dtattributes[-1]{$a} = $b } elsif(defined($a)){$dtattributes[-1]{$a} } else {$dtattributes[-1] } } sub pathdtstring{ my $string = shift; my %h = _pathtodt(@_); return dtstring($string,%h); } sub pathdturl{ my $url = shift; my %h = _pathtodt(@_); return dturl($url,%h); } sub dturl{ my $url = shift; my $contents = get($url); if ($contents) { return dtstring($contents, @_); } else { return undef; } } sub dtstring { my ($string, %xml)=@_; my ($parser, $tree); my $declr = ""; if ($xml{-declr}) { if ($xml{-outputenc}) { $declr = "\n"; } else { $declr = "\n"; } } $xml{'-type'} = {} unless defined $xml{'-type'}; %ty = (%{$xml{'-type'}}, -ROOT => "NONE"); # execute Begin action if it exists if ($xml{-begin}) { &{$xml{-begin}} } if ($xml{-inputenc}) { $string = XML::LibXML::encodeToUTF8($xml{-inputenc}, $string); } # create a new LibXML parser $parser = XML::LibXML->new(); $parser->validation(0); $parser->load_ext_dtd(0); $parser->expand_entities(0); # parse the string my $doc; if ( $xml{'-recover'}) { $parser->recover(1); eval { local $SIG{__WARN__} = sub{}; $doc = $parser->parse_string($string); }; return undef if !$doc; } elsif ( $xml{'-html'}) { $parser->recover(1); eval{ local $SIG{__WARN__} = sub{}; $doc = $parser->parse_html_string($string); }; # if ($@) { return undef; } return undef unless defined $doc; } else { $doc = $parser->parse_string($string); } # get the document root element $tree = $doc->getDocumentElement(); my $return; # Check if we have an end function if ($xml{-end}) { $c = _omni("-ROOT", \%xml, $tree); $return = &{$xml{-end}} } else { $return = _omni("-ROOT", \%xml, $tree) } if ($declr) { return $declr.$return; } else { return $return; } } sub pathdt{ my $file = shift; my %h = _pathtodt(@_); return dt($file,%h); } # Parsing dos predicados do XPath sub _testAttr { my $atr = shift; for ($atr) { s/name\(\)/'$q'/g; # s/\@([A-Za-z_]+)/'$v{$1}'/g; s/\@([A-Za-z_]+)/defined $v{$1}?"'$v{$1}'":"''"/ge; s/\@\*/keys %v?"'1'":"''"/ge; if (/^not\((.*)\)$/) { return ! _testAttr($1); } elsif (/^('|")([^\1]*)(\1)\s*=\s*('|")([^\4]*)\4$/) { return ($2 eq $5); } elsif (/^(.*?)normalize-space\((['"])([^\2)]*)\2\)(.*)$/) { my ($back,$forward)=($1,$4); my $x = _normalize_space($3); return _testAttr("$back'$x'$forward"); } elsif (/starts-with\((['"])([^\1))]*)\1,(['"])([^\3))]*)\3\)/) { my $x = _starts_with($2,$4); return $x; } elsif (/contains\((['"])([^\1))]*)\1,(['"])([^\3))]*)\3\)/) { my $x = _contains($2,$4); return $x; } elsif (/^(.*?)string-length\((['"])([^\2]*)\2\)(.*)$/) { my ($back,$forward) = ($1,$4); my $x = length($3); return _testAttr("$back$x$forward"); } elsif (/^(\d+)\s*=(\d+)$/) { return ($1 == $2); } elsif (/^(\d+)\s*<(\d+)$/) { return ($1 < $2); } elsif (/^(\d+)\s*>(\d+)$/) { return ($1 > $2); } elsif (/^(['"])([^\1]*)\1$/) { return $2; } } return 0; #$atr; } # Funcao auxiliar de teste de predicados do XPath sub _starts_with { my ($string,$preffix) = @_; return 0 unless ($string && $preffix); return 1 if ($string =~ m!^$preffix!); return 0; } # Funcao auxiliar de teste de predicados do XPath sub _contains { my ($string,$s) = @_; return 0 unless ($string && $s); return 1 if ($string =~ m!$s!); return 0; } # Funcao auxiliar de teste de predicados do XPath sub _normalize_space { my $z = shift; $z =~ /^\s*(.*?)\s*$/; $z = $1; $z =~ s!\s+! !g; return $z; } sub _pathtodt { my %h = @_; my %aux=(); my %aux2=(); my %n = (); my $z; for $z (keys %h) { # TODO - Make it more generic if ( $z=~m{\w+(\|\w+)+}) { my @tags = split /\|/, $z; for(@tags) { $aux2{$_}=$h{$z} } } elsif ( $z=~m{(//|/|)(.*)/([^\[]*)(?:\[(.*)\])?} ) { my ($first,$second,$third,$fourth) = ($1,$2,$3,$4); if (($first eq "/") && (!$second)) { $first = ""; $second = '.*'; $third =~ s!\*!-default!; } else { $second =~ s!\*!\[^/\]\+!g; $second =~ s!/$!\(/\.\*\)\?!g; $second =~ s!//!\(/\.\*\)\?/!g; $third =~ s!\*!-default!g; } push( @{$aux{$third}} , [$first,$second,$h{$z},$fourth]); } else { $aux2{$z}=$h{$z};} } for $z (keys %aux){ my $code = sub { my $l; for $l (@{$aux{$z}}) { my $prefix = ""; $prefix = "^" unless (($l->[0]) or ($l->[1])); $prefix = "^" if (($l->[0] eq "/") && ($l->[1])); if ($l->[3]) { if(inctxt("$prefix$l->[1]") && _testAttr($l->[3])) {return &{$l->[2]}; } } else { if(inctxt("$prefix$l->[1]")) {return &{$l->[2]};} } } return &{ $aux2{$z}} if $aux2{$z} ; return &{ $h{-default}} if $h{-default}; &toxml(); }; $n{$z} = $code; } for $z (keys %aux2){ $n{$z} ||= $aux2{$z} ; } return %n; } sub _omni { my ($par, $xml, @l) = @_; my $defaulttype = (exists($xml->{-type}) && exists($xml->{-type}{-default})) ? $xml->{-type}{-default} : "STR"; my $type = $ty{$par} || $defaulttype; my %typeargs = (); if (ref($type) eq "mmapon") { $typeargs{$_} = 1 for (@$type); $type = "MMAPON"; } my $r ; if( $type eq 'STR') { $r = "" } elsif( $type eq 'THE_CHILD' or $type eq 'LAST_CHILD') { $r = 0 } elsif( $type eq 'SEQ' or $type eq "ARRAY") { $r = [] } elsif( $type eq 'SEQH' or $type eq "ARRAYOFHASH") { $r = [] } elsif( $type eq 'MAP' or $type eq "HASH") { $r = {} } elsif( $type eq 'MULTIMAP') { $r = {} } elsif( $type eq 'MMAPON' or $type eq "HASHOFARRAY") { $r = {} } elsif( $type eq 'NONE') { $r = "" } elsif( $type eq 'ZERO') { return "" } my ($name, $val, @val, $atr, $aux); $u = $xml->{-userdata}; while(@l) { my $tree = shift @l; next unless $tree; $name = ref($tree) eq "XML::LibXML::CDATASection" ? "-pcdata" : $tree->getName(); if (ref($tree) eq "XML::LibXML::CDATASection") { $val = $tree->getData(); $name = "-cdata"; $aux = (defined($xml->{-outputenc}))?_fromUTF8($val,$xml->{-outputenc}):$val; if (defined($xml->{-cdata})) { push(@dtcontext,"-cdata"); $c = $aux; $aux = &{$xml->{-cdata}}; pop(@dtcontext); } elsif (defined($xml->{-pcdata})) { push(@dtcontext,"-pcdata"); $c = $aux; $aux = &{$xml->{-pcdata}}; pop(@dtcontext); } } elsif (ref($tree) eq "XML::LibXML::Comment") { ### At the moment, treat as Text ### We will need to change this, I hope! $val = ""; $name = "-pcdata"; $aux= (defined($xml->{-outputenc}))?_fromUTF8($val, $xml->{-outputenc}):$val; if (defined($xml->{-pcdata})) { push(@dtcontext,"-pcdata"); $c = $aux; $aux = &{$xml->{-pcdata}}; pop(@dtcontext); } } elsif (ref($tree) eq "XML::LibXML::Text") { $val = $tree->getData(); $name = "-pcdata"; $aux = (defined($xml->{-outputenc}))?_fromUTF8($val,$xml->{-outputenc}):$val; if (defined($xml->{-pcdata})) { push(@dtcontext,"-pcdata"); $c = $aux; $aux = &{$xml->{-pcdata}}; pop(@dtcontext); } } elsif (ref($tree) eq "XML::LibXML::Element") { my %atr = _nodeAttributes($tree); $atr = \%atr; if (exists($xml->{-ignorecase})) { $name = lc($name); for (keys %$atr) { my ($k,$v) = (lc($_),$atr->{$_}); delete($atr->{$_}); $atr->{$k} = $v; } } push(@dtcontext,$name); $dtcontextcount{$name}++; unshift(@dtatributes, $atr); unshift(@dtattributes, $atr); $aux = _omniele($xml, $name, _omni($name, $xml, ($tree->getChildnodes())), $atr); shift(@dtatributes); shift(@dtattributes); pop(@dtcontext); $dtcontextcount{$name}--; } elsif (ref($tree) eq "XML::LibXML::Node") { if ($tree->nodeType == XML_ENTITY_REF_NODE) { # if we get here, is because we are not expanding entities (I think) if ($tree->textContent) { $aux = $tree->textContent; } else { $aux = '&'.$tree->nodeName.';'; } } else { print STDERR "Not handled, generic node of type: [",$tree->nodeType,"]\n"; } } else { print STDERR "Not handled: [",ref($tree),"]\n"; } if ($type eq "STR"){ if (defined($aux)) {$r .= $aux} ;} elsif ($type eq "THE_CHILD" or $type eq "LAST_CHILD"){ $r = $aux unless _whitepc($aux, $name); } elsif ($type eq "SEQ" or $type eq "ARRAY"){ push(@$r, $aux) unless _whitepc($aux, $name);} elsif ($type eq "SEQH" or $type eq "ARRAYHASH"){ push(@$r,{"-c" => $aux, "-q" => $name, _nodeAttributes($tree) }) unless _whitepc($aux,$name); } elsif($type eq "MMAPON"){ if(not _whitepc($aux,$name)){ if(! $typeargs{$name}) { warn "duplicated tag '$name'\n" if(defined($r->{$name})); $r->{$name} = $aux } else { push(@{$r->{$name}},$aux) unless _whitepc($aux,$name)}} } elsif($type eq "MAP" or $type eq "HASH"){ if(not _whitepc($aux,$name)){ warn "duplicated tag '$name'\n" if(defined($r->{$name})); $r->{$name} = $aux }} elsif($type eq "MULTIMAP"){ push(@{$r->{$name}},$aux) unless _whitepc($aux,$name)} elsif($type eq "NONE"){ $r = $aux;} else { $r="undefined type !!!"} } $r; } sub _omniele { my $xml = shift; my $aux; ($q, $c, $aux) = @_; %v = %$aux; if (defined($xml->{-outputenc})) { for (keys %v){ $v{$_} = _fromUTF8($v{$_}, $xml->{-outputenc}) } } if (defined $xml->{$q}) { &{$xml->{$q}} } elsif (defined $xml->{'-default'}) { &{$xml->{'-default'}} } elsif (defined $xml->{'-tohtml'}) { tohtml() } else { toxml() } } sub xmltree { +{'-c' => $c, '-q' => $q, %v} } sub tohtml { my ($q,$v,$c); if (not @_) { ($q,$v,$c) = ($XML::DT::q, \%XML::DT::v, $XML::DT::c); } elsif (ref($_[0])) { $c = shift; } else { ($q,$v,$c) = @_; } if (not ref($c)) { if ($q eq "-pcdata") { return $c } elsif ($q eq "link" || $q eq "br" || $q eq "hr" || $q eq "img") { return _openTag($q,$v) } else { return _openTag($q,$v) . "$c" } } elsif (ref($c) eq "HASH" && $c->{'-q'} && $c->{'-c'}) { my %a = %$c; my ($q,$c) = delete @a{"-q","-c"}; tohtml($q,\%a,(ref($c)?tohtml($c):$c)); } elsif (ref($c) eq "HASH") { _openTag($q,$v). join("",map {($_ ne "-pcdata") ? ( (ref($c->{$_}) eq "ARRAY") ? "<$_>". join("\n<$_>", @{$c->{$_}}). "\n" : tohtml($_,{},$c->{$_})."\n" ) : () } keys %{$c} ) . "$c->{-pcdata}" } ######## "NOTYetREady" elsif (ref($c) eq "ARRAY") { if (defined($q) && exists($ty{$q}) && $ty{$q} eq "SEQH") { tohtml($q,$v,join("\n",map {tohtml($_)} @$c)) } elsif (defined $q) { tohtml($q,$v,join("",@{$c})) } else { join("\n",map {(ref($_)?tohtml($_):$_)} @$c) } } } sub toxml { my ($q,$v,$c); if (not @_) { ($q, $v, $c) = ($XML::DT::q, \%XML::DT::v, $XML::DT::c); } elsif (ref($_[0])) { $c = shift; } else { ($q, $v, $c) = @_; } if (not ref($c)) { if ($q eq "-pcdata") { return $c } elsif ($c eq "") { return _emptyTag($q,$v) } else { return _openTag($q,$v) . "$c" } } elsif (ref($c) eq "HASH" && $c->{'-q'} && $c->{'-c'}) { my %a = %$c; my ($q,$c) = delete @a{"-q","-c"}; ### _openTag($q,\%a).toxml($c).). ### toxml($q,\%a,join("\n",map {toxml($_)} @$c)) toxml($q,\%a,(ref($c)?toxml($c):$c)); } elsif (ref($c) eq "HASH") { _openTag($q,$v). join("",map {($_ ne "-pcdata") ? ( (ref($c->{$_}) eq "ARRAY") ? "<$_>". join("\n<$_>", @{$c->{$_}}). "\n" : toxml($_,{},$c->{$_})."\n" ) : () } keys %{$c} ) . "$c->{-pcdata}" } ######## "NOTYetREady" elsif (ref($c) eq "ARRAY") { if (defined($q) && exists($ty{$q}) && $ty{$q} eq "SEQH") { toxml($q,$v,join("\n",map {toxml($_)} @$c)) } elsif (defined $q) { toxml($q,$v,join("",@{$c})) } else { join("\n",map {(ref($_)?toxml($_):$_)} @$c) } } } sub _openTag{ "<$_[0]". join("",map {" $_=\"$_[1]{$_}\""} keys %{$_[1]} ).">" } sub _emptyTag{ "<$_[0]". join("",map {" $_=\"$_[1]{$_}\""} keys %{$_[1]} )."/>" } sub mkdtskel_fromDTD { my $filename = shift; my $file = ParseDTDFile($filename); print <<'PERL'; #!/usr/bin/perl use warnings; use strict; use XML::DT; my $filename = shift; # Variable Reference # # $c - contents after child processing # $q - element name (tag) # %v - hash of attributes my %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, PERL for (sort keys %{$file}) { print " '$_' => sub { },"; print " # attributes: ", join(", ", keys %{$file->{$_}{attributes}}) if exists($file->{$_}{attributes}); print "\n"; } print <<'PERL'; ); print dt($filename, %handler); PERL } sub mkdtskel{ my @files = @_; my $name; my $HTML = ""; my %element; my %att; my %mkdtskel = ('-default' => sub{ $element{$q}++; for (keys %v) { $att{$q}{$_} = 1 }; ""}, '-end' => sub{ print <<'END'; #!/usr/bin/perl use XML::DT; use warnings; use strict; my $filename = shift; # Variable Reference # # $c - contents after child processing # $q - element name (tag) # %v - hash of attributes my %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, END print $HTML; for $name (sort keys %element) { print " '$name' => sub{ }, #"; print " $element{$name} occurrences;"; print ' attributes: ', join(', ', keys %{$att{$name}}) if $att{$name}; # print " \"\$q:\$c\"\n"; print "\n"; } print <<'END'; ); print dt($filename, %handler); END } ); my $file = shift(@files); while($file =~ /^-/){ if ($file eq "-html") { $HTML = " '-html' => 1,\n"; $mkdtskel{'-html'} = 1;} elsif($file eq "-latin1") { $mkdtskel{'-inputenc'}='ISO-8859-1';} else { die("usage mktskel [-html] [-latin1] file \n")} $file=shift(@files)} dt($file,%mkdtskel) } sub _nodeAttributes { my $node = shift; my %answer = (); my @attrs = $node->getAttributes(); for (@attrs) { if (ref($_) eq "XML::LibXML::Namespace") { # TODO: This should not be ignored, I think. # This sould be converted on a standard attribute with # key 'namespace' and respective contents } else { $answer{$_->getName()} = $_->getValue(); } } return %answer; } sub mkdtdskel { my @files = @_; my $name; my %att; my %ele; my %elel; my $root; my %handler=( '-outputenc' => 'ISO-8859-1', '-default' => sub{ $elel{$q}++; $root = $q unless ctxt(1); $ele{ctxt(1)}{$q} ++; for(keys(%v)){$att{$q}{$_} ++ } ; }, '-pcdata' => sub{ if ($c =~ /[^ \t\n]/){ $ele{ctxt(1)}{"#PCDATA"}=1 }}, ); while($files[0] =~ /^-/){ if ($files[0] eq "-html") { $handler{'-html'} = 1;} elsif($files[0] eq "-latin1") { $handler{'-inputenc'}='ISO-8859-1';} else { die("usage mkdtdskel [-html] [-latin1] file* \n")} shift(@files)} for my $filename (@files){ dt($filename,%handler); } print "\n\n"; delete $elel{$root}; for ($root, keys %elel){ _putele($_, \%ele); for $name (keys(%{$att{$_}})) { print( "\t\n"); print( "\t\n"); } } } sub _putele { my ($e,$ele) = @_; my @f ; if ($ele->{$e}) { @f = keys %{$ele->{$e}}; print "= 1 && $f[0] eq "#PCDATA" ? "" : "*"), " >\n"; print "\n"; } else { print "\n"; } } sub _whitepc { $_[1] eq '-pcdata' and $_[0] =~ /^[ \t\r\n]*$/ } sub MMAPON { bless([@_],"mmapon") } sub _fromUTF8 { my $string = shift; my $encode = shift; my $ans = eval { XML::LibXML::decodeFromUTF8($encode, $string) }; if ($@) { return $string } else { return $ans } } 1; XML-DT-0.63/examples/10nov.sgm000644 000765 000024 00000002471 11411137227 015770 0ustar00ambsstaff000000 000000 Terça-feira, 10 de Novembro de 1998 1ª PÁGINA Governo Preocupado com Vitória do "Não" Guterres Encomenda Estudo de Popularidade

A vitória do "não" deixou o Governo intranquilo. Olha-se para a "Alternativa Democrática" mas também para as consequências da derrota do "sim" na imagem de Guterres e do seu Executivo. Por isso decidiram, ontem, mandar fazer uma sondagem. A da RTP-1, no domingo, que dava maioria ao PS, não chegou para dar confiança aos socialistas.

Mas em relação à "AD" o tempo é de expectativa. Ambos os partidos criticaram durante duramente a proposta de Orçamento por, alegadamente, agravar a carga fiscal sobre a classe média. Mas ainda não apresentaram propostas alternativas. Só perante isso é que os socialistas definirão o que é negociável e o que não é. Aí, garantiu o membro do Governo ouvido pelo PÚBLICO, haverá "muita firmeza". 1ª PÁGINA Que Fazer com Pinochet?

A defesa de Pinochet começou a puxar dos trunfos: a continuada prisão do general pode ter consequências no Chile, onde as coisas são "frágeis". A Espanha formaliza hoje à Grã-Bretanha o pedido de extradição do militar. Os Lordes poderão anunciar a sua decisão na quinta-feira.

XML-DT-0.63/examples/arq.pl000644 000765 000024 00000002126 10730327732 015437 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = shift; $f=sub{for (@isa) {$ind{$_}= [@{$ind{$_}},[$url,$title]]}; $url=$title=""; @isa=(); "

  • $c"}; %xml=( 'foto' => $f, 'desenho' => $f, 'aguarela'=> $f, 'url' => sub{$url=$c;""}, 'title' => sub{$title=$c;"$c[$res]
    "}, 'isa' => sub{push(@isa,n($c));" ($c)"}, 'author' => sub{ " $c " }, 'resol' => sub{$res=$c;""}, 'arq' => sub{$c}, # '-default'=> sub{"
  • $q:$c"}, '-outputenc' => 'ISO-8859-1', ); $imglist = "
      " . dt($filename,%xml). "
    " ; print "

    Arquivo de imagens

    ", mkind(%ind), "

    Lista das imagens

    $imglist"; sub mkind{ my %a=@_; my $r="

    Indice

      "; for $p (sort keys %a){ $r.= "
    • $p -- " ; } $r . "
    "; } sub n{ my $a= lc(shift) ; for($a){ s/^ +//; s/ +$//; s/ +/ /g; } $a; } XML-DT-0.63/examples/arq.xml000644 000765 000024 00000013671 10730327732 015633 0ustar00ambsstaff000000 000000 9809/P0000146.JPG1536 1024 Arcada Augustsson Braga Praça 9809/P0000151.JPG 1536 1024 Prédio da Brasileira café Brasileira (Braga) Augustsson Braga café 9809/P0000153.JPG1536 1024 Jardins de S.Bárbara, flores Augustsson Braga Jardim 9809/P0000154.JPG1536 1024 flores (não sei o nome) Augustsson Braga/Jardim S.Bárbara flor 9809/P0000156.JPG1536 1024 flores (não sei o nome) Augustsson Braga/Jardim S.Bárbara flor 9809/P0000157.JPG1536 1024 Biblioteca: edifício medieval, visto de jardim de S. Bárbara Augustsson Braga monumento jardim 9809/P0000158.JPG1536 1024 Câmara Municipal de Braga Augustsson Braga convento praça 9809/P0000160.JPG1536 1024 Biblioteca Pública de Braga entrada barroca Augustsson Braga/Praça do Município monumento biblioteca 9809/P0000161.JPG1536 1024 Sé de Braga:Estátua da Senhora do Leite Augustsson Braga/Sé estátua 9809/P0000163.JPG1536 1024 Igreja de S.Marcos Augustsson Braga igreja 9809/P0000164.JPG1536 1024 Igreja de St. Cruz Augustsson Braga igreja 9809/P0000240.JPG1536 1024 Estátua de D.Afonso Henriques Augustsson Guimarães estátua 9809/P0000254.JPG1536 1024 Rua estreita em Guimarães Augustsson Guimarães rua 9809/P0000256.JPG1536 1024 Biblioteca antiga de Guimarães, junto à Oliveira Augustsson Guimarães monumento 9809/P0000257.JPG1536 1024 Cruzeiro junto à Oliveira Augustsson Guimarães monumento 9809/P0000241.JPG1536 1024 Paço dos Duques de Bragança Augustsson Guimarães Paço 9811/brasileira.jpg 1300 1000 Esplanada do café Brasileira jj café Brasileira (Braga) Braga café esplanada 1989 9811/castelo.jpg1300 1000 Rua do Castelo, torre da igreja dos Terceiros jj Braga rua igreja_po 9811/claraboi.jpg1300 1000 Pópulo: torreão visto pelas traseiras jj Braga promenor arq. igreja_po 1997 9811/janela.jpg1300 1000 Largo de S.Victor: Janelas de rótulo e nicho jj Braga janela casa 1989 9811/mosteiro.jpg1300 1000 Mosteiro de Rendufe jj Braga igreja monumento 9811/ruina.jpg1300 1000 R. D. Pedro V: Casa arruinada; janela guilhotina/3 jj Braga casa janela 1989 9811/tabique.jpg1300 1000 R. ?: Casa arruinada com grade do tabique e janelas de rótula jj Braga casa janela promenor arq. 1989 9812/santo.jpg1036 690 Cara de um santo, Bom Jesus Cara de um santo numa das capelinhas da via-sacra do Bom Jesus jbb Braga/Bom Jesus estátua santo 1998 9902/cabreira.jpg1024 728 Paisagem da Cabreira paisagem da serra da Cabreira junto `a casa abrigo da Serradela jj Minho/Serra da Cabreira/serradela aguarela paisagem etnografia 1998 9902/flautista.jpg840 680 flautista velho a tocar flauta (desenho a caneta, preto e branco) jj desenho música etnografia 1998 9902/mariana1.jpg340 680 Marina a desenhar Marina a desenhar (desenho a grafite) jj desenho 1998 XML-DT-0.63/examples/ex.xml000644 000765 000024 00000000543 10730327732 015456 0ustar00ambsstaff000000 000000 Luís Represas Camões an element with attributs Fora do tempo letra incompleta An empty element with attributs Fora do tempo ... Vindos da mesma mãe.. O tempo também se engana ... XML-DT-0.63/examples/ex1.pl000644 000765 000024 00000000562 10730327732 015353 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = shift; %xml=( 'music' => sub{"Autor da musica: $c"}, 'musica' => sub{"--------------(AMP)--------\n$c"}, 'lyrics' => sub{"Autor da letra:$c"}, 'title' => sub{ uc($c) . $v{acordes} }, '-default' => sub{"$q:$c"}, '-outputenc' => 'ISO-8859-1' ); print &dt($filename,%xml); XML-DT-0.63/examples/ex10.1.pl000644 000765 000024 00000001560 10730327732 015571 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT; use Data::Dumper; %handler = ( -default => sub{$c}, packages => sub{ [ split(",",$c)] }, -type => { vendorinfo => 'MAP', paks => 'SEQ' } ); $a = dtstring (" netscape.com netscape.commmm Netscape active communicator-4.07, communicator-4.5, navigator-4.07 ",%handler); print Dumper($a); $a = dtstring (" netscape.com netscape.commmm Netscape active communicator-4.07 communicator-4.5, navigator-4.07 ",%handler); print Dumper($a); XML-DT-0.63/examples/ex10.2.pl000644 000765 000024 00000000435 10730327732 015572 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT; %handler = ( contacts => sub{ [ split(";",$c)] }, -default => sub{$c}, -type => { institution => 'MAP', tels => 'SEQ' }); $a = dt("ex10.2.xml", %handler); use Data::Dumper; print Dumper($a); XML-DT-0.63/examples/ex10.2.xml000644 000765 000024 00000000362 10730327732 015756 0ustar00ambsstaff000000 000000 U.M. University of Minho 1111 1112 1113 Portugal J.Joao; J.Rocha; J.Ramalho XML-DT-0.63/examples/ex10.3.pl000644 000765 000024 00000000556 10730327732 015577 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT; use Data::Dumper; print Dumper(MMAPON('name')); %handler = ( contacts => sub{ [ split(";",$c)] }, -default => sub{$c}, -type => { institution => 'MAP', degrees => MMAPON('name'), tels => 'SEQ' }); $a = dt(shift, %handler); print Dumper($a); XML-DT-0.63/examples/ex10.3.xml000644 000765 000024 00000000532 10730327732 015756 0ustar00ambsstaff000000 000000 U.M. University of Minho 1111 1112 1113 Portugal J.Joao; J.Rocha; J.Ramalho Computer science informatic history XML-DT-0.63/examples/ex11.1.pl000644 000765 000024 00000000621 10730327732 015567 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT; use Data::Dumper; %handler = ( -default => sub{$c}, person => sub{ print " $c->{name} $c->{address}[0] Dear $c->{name} Merry Christmas from Morris\n"; $c;}, -type => { people => 'SEQ', person => MMAPON('address')}); $people = dt("ex11.1.xml", %handler); print Dumper($people); print $people->[1]{address}[1]; XML-DT-0.63/examples/ex11.1.xml000644 000765 000024 00000000423 10730327732 015754 0ustar00ambsstaff000000 000000 name0
    address00
    address01
    name1
    address10
    address11
    XML-DT-0.63/examples/ex11.5.pl000644 000765 000024 00000002677 10730327732 015610 0ustar00ambsstaff000000 000000 ####################################################### #I am using XML::DT as below (the require is for selective module loading): ####################################################### # #require XML::DT; XML::DT->import (); # Yes !!! use strict; use Data::Dumper; use XML::DT; my @order=qw(volume issue doi author f_page l_page artid epub ppub type); my $M; my %handler = ( '-default' => sub {$c}, 'article' => sub { # $v{issue} = $dtattributes[1]->{number}; # $v{volume} = $dtattributes[2]->{number}; $v{issue} = father("number"); $v{volume} = gfather("number"); $M .= join(" :\t", @v{(@order)}) . "\n"; }, ); dt ("ex11.5.xml", %handler); print $M; __END__
    XML-DT-0.63/examples/ex11.5.xml000644 000765 000024 00000002731 10730327732 015764 0ustar00ambsstaff000000 000000
    XML-DT-0.63/examples/ex2.pl000644 000765 000024 00000001571 10730327732 015355 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; use Data::Dumper; my $filename = shift; %xml2=('foto' => sub{$ind{$isa}= [@{$ind{$isa}},$url]; $isa=$url=""; "
  • $c"}, 'url' => sub{$url=$c;"$c"}, 'isa' => sub{$isa=lc($c);$c}, 'author' => sub{uc($c) }, 'resol' => sub{""}, 'arq' => sub{"Indice\n". Dumper(\%ind) . "----------\n$c"}, '-default'=> sub{"$q:$c"}, '-outputenc' => 'ISO-8859-1' ); %xml=( 'music' => sub{"Autor da musica: $c"}, 'musica' => sub{"--------------(AMP)--------\n$c"}, 'lyrics' => sub{"Autor da letra:$c"}, 'title' => sub{ uc($c) . $v{acordes} }, '-default' => sub{"$q:$c"}, 'arquivo' => sub{("_" x 60). dt($v{file},%xml2)}, '-outputenc' => 'ISO-8859-1' ); print dt($filename,%xml); XML-DT-0.63/examples/ex3.xml000644 000765 000024 00000000611 10730327732 015535 0ustar00ambsstaff000000 000000 Luís Represas Camões an element with attributs Fora do tempo letra incompleta An empty element with attributs Fora do tempo ... Vindos da mesma mãe.. O tempo também se engana ... XML-DT-0.63/examples/ex5.pl000644 000765 000024 00000001035 10730327732 015353 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; use Data::Dumper; sub XML::DT::Dumper {}# Dumper(shift)} my $filename = shift; %xml=( 'music' => sub{"Autor da musica: $c ($v{x})"}, 'musica' => sub{"\n--------------(AMP)$v{x}--------\n$c"}, '-default' => sub{"contexto=".join("/",@dtcontext). "\n $q:$c\n". "pai=". ctxt(1). "\n" }, 'arquivo' => sub{("_" x 60). dt($v{file},%xml2)}, '-outputenc' => 'ISO-8859-1' ); # print dt("$filename"); print dt($filename,%xml); XML-DT-0.63/examples/ex6.pl000644 000765 000024 00000001134 10730327732 015354 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; use Data::Dumper; sub XML::DT::Dumper {}# Dumper(shift)} my $filename = shift; %xml=( '-default' => sub{ if(inctxt('url')) {"\n (sunof url) $q:$c\n pai=". ctxt(1). "\n" } elsif(inctxt('foto')) {"\n (sun of foto) $q:$c\n pai=". ctxt(1). "\n" } elsif(inctxt('desenho.*')) {"\n (desenho....) $q:$c\n pai=". ctxt(1). "\n" } else {"\n (outros) $q:$c\n pai=". ctxt(1). "\n" } }, '-outputenc' => 'ISO-8859-1' ); # print dt("$filename"); print dt($filename,%xml); XML-DT-0.63/examples/ex7.pl000644 000765 000024 00000007400 10730327732 015357 0ustar00ambsstaff000000 000000 #!/usr/bin/perl # # see comments in the end # use XML::DT ; my $filename = shift; my $beginLatex = '\documentclass{article} \usepackage[latin1]{inputenc} \usepackage{t1enc} \bibliographystyle{plain} \begin{document} '; my $endLatex = '\end{document} '; my @aut=(); %handler=( '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, '-begin' => sub{print"BEGIN\n"}, '-end' => sub{print"end\n";"$beginLatex$c$endLatex"}, '-pcdata' => sub{ if(inctxt('(SECTION|SUBSEC1)')) {$c =~ s/[\s\n]+/ /g; $c } $c }, 'RANDLIST' => sub{"\\begin{itemize}$c\\end{itemize}"}, 'AFFIL' => sub{""}, 'TITLE' => sub{ if(inctxt('SECTION')){"\\section{$c}"} elsif(inctxt('SUBSEC1')){"\\subsection{$c}"} else {"\\title{$c}"} }, 'GCAPAPER' => sub{"$c"}, 'PARA' => sub{"$c\n\n"}, 'ADDRESS' => sub{"\\thanks{$c}"}, 'PUB' => sub{"} $c"}, 'FNAME' => sub{" $c"}, 'EMAIL' => sub{"(\\texttt{$c}) "}, 'FRONT' => sub{"$c\n"}, 'REAR' => sub{"$c"}, 'BIB' => sub{"$c"}, 'BODY' => sub{"$c"}, 'AUTHOR' => sub{ push @aut, $c ; ""}, 'ABSTRACT' => sub{ sprintf('\author{%s}\maketitle\begin{abstract}%s\end{abstract}', join ('\and', @aut) , $c) }, 'CODE.BLOCK' => sub{"\\begin{verbatim}\n$c\\end{verbatim}\n"}, 'XREF' => sub{"\\cite{$v{REFLOC}}"}, 'SECTION' => sub{"$c"}, 'LI' => sub{"\\item $c"}, 'SUBSEC1' => sub{"$c"}, 'BIBLIOG' => sub{"\n\\begin{thebibliography}{1}\n$c\n\\end{thebibliography}\n"}, 'HIGHLIGHT' => sub{" \\emph{$c} "}, 'BIO' => sub{""}, 'SURNAME' => sub{" $c "}, 'CODE' => sub{"\\verb!$c!"}, 'BIBITEM' => sub{"\n\\bibitem{$c"}, ); print dt($filename,%handler); =head1 NAME gcapaper2tex.pl - a perl script to translate XML gcapaper DTD to latex =head1 SYNOPSIS gcapapape2tex.pl mypaper.xml > mupaper.tex =head1 notes This is an example of the use of XML::DT module =head1 The Code use XML::DT ; my $filename = shift; my $beginLatex = '\documentclass{article} \usepackage[latin1]{inputenc} \usepackage{t1enc} \bibliographystyle{plain} \begin{document} '; my $endLatex = '\end{document} '; my @aut=(); %handler=( '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, '-pcdata' => sub{ if(inctxt('(SECTION|SUBSEC1)')) {$c =~ s/[\s\n]+/ /g; $c } $c }, 'RANDLIST' => sub{"\\begin{itemize}$c\\end{itemize}"}, 'AFFIL' => sub{""}, 'TITLE' => sub{ if(inctxt('SECTION')){"\\section{$c}"} elsif(inctxt('SUBSEC1')){"\\subsection{$c}"} else {"\\title{$c}"} }, 'GCAPAPER' => sub{"$beginLatex $c $endLatex"}, 'PARA' => sub{"$c\n\n"}, 'ADDRESS' => sub{"\\thanks{$c}"}, 'PUB' => sub{"} $c"}, 'FNAME' => sub{" $c"}, 'EMAIL' => sub{"(\\texttt{$c}) "}, 'FRONT' => sub{"$c\n"}, 'REAR' => sub{"$c"}, 'BIB' => sub{"$c"}, 'BODY' => sub{"$c"}, 'AUTHOR' => sub{ push @aut, $c ; ""}, 'ABSTRACT' => sub{ sprintf('\author{%s}\maketitle\begin{abstract}%s\end{abstract}', join ('\and', @aut) , $c) }, 'CODE.BLOCK' => sub{"\\begin{verbatim}\n$c\\end{verbatim}\n"}, 'XREF' => sub{"\\cite{$v{REFLOC}}"}, 'SECTION' => sub{"$c"}, 'LI' => sub{"\\item $c"}, 'SUBSEC1' => sub{"$c"}, 'BIBLIOG' => sub{"\n\\begin{thebibliography}{1}\n$c\n\\end{thebibliography}\n"}, 'HIGHLIGHT' => sub{" \\emph{$c} "}, 'BIO' => sub{""}, 'SURNAME' => sub{" $c "}, 'CODE' => sub{"\\verb!$c!"}, 'BIBITEM' => sub{"\n\\bibitem{$c"}, ); print dt($filename,%handler); =head1 author J.Joao Almeida (jj@di.uminho.pt) XML-DT-0.63/examples/gcapaper2tex.pl000644 000765 000024 00000003454 10730327732 017246 0ustar00ambsstaff000000 000000 #!/usr/bin/perl =head1 NAME gcapaper2tex.pl - a perl script to translate XML gcapaper DTD to latex =head1 SYNOPSIS gcapapape2tex.pl mypaper.xml > mupaper.tex =head1 Notes This is an example of the use of XML::DT module. It was partially generated with mkskel.pl script =cut use XML::DT ; my $filename = shift; my $beginLatex = '\documentclass{article} \usepackage[latin1]{inputenc} \usepackage{t1enc} \bibliographystyle{plain} \begin{document} '; my $endLatex = '\end{document} '; my @aut=(); %handler=( '-outputenc' => 'ISO-8859-1', '-default' => sub{"$c"}, 'RANDLIST' => sub{"\\begin{itemize}$c\\end{itemize}"}, 'AFFIL' => sub{""}, 'TITLE' => sub{ if(inctxt('SECTION')){"\\section{$c}"} elsif(inctxt('SUBSEC1')){"\\subsection{$c}"} else {"\\title{$c}"} }, 'GCAPAPER' => sub{"$beginLatex $c $endLatex"}, 'PARA' => sub{"$c\n\n"}, 'ADDRESS' => sub{"\\thanks{$c}"}, 'PUB' => sub{"} $c"}, 'FNAME' => sub{" $c"}, 'EMAIL' => sub{"(\\texttt{$c}) "}, 'FRONT' => sub{"$c\n"}, 'AUTHOR' => sub{ push @aut, $c ; ""}, 'ABSTRACT' => sub{ sprintf('\author{%s}\maketitle\begin{abstract}%s\end{abstract}', join ('\and', @aut) , $c) }, 'CODE.BLOCK' => sub{"\\begin{verbatim}\n$c\\end{verbatim}\n"}, 'XREF' => sub{"\\cite{$v{REFLOC}}"}, 'SECTION' => sub{"$c"}, 'LI' => sub{"\\item $c"}, 'BIBLIOG' => sub{"\n\\begin{thebibliography}{1}\n$c\n\\end{thebibliography}\n"}, 'HIGHLIGHT' => sub{" \\emph{$c} "}, 'BIO' => sub{""}, 'SURNAME' => sub{" $c "}, 'CODE' => sub{"\\verb!$c!"}, 'BIBITEM' => sub{"\n\\bibitem{$c"}, ); print dt($filename,%handler); =head1 author J.Joao Almeida (jj@di.uminho.pt) XML-DT-0.63/examples/jj.dtd000644 000765 000024 00000000257 10730327732 015422 0ustar00ambsstaff000000 000000 XML-DT-0.63/examples/lat1.html000644 000765 000024 00000001025 10730327732 016043 0ustar00ambsstaff000000 000000 C<lat1.pm> - module for unicode utf8 -> latin1 translation of strings

    NAME

    lat1.pm - module for unicode utf8 -> latin1 translation of strings

    SYNOPSIS 

       $latin1string = lat1::utf8($utf8string)

    XML-DT-0.63/examples/makefile000644 000765 000024 00000000575 10730327732 016025 0ustar00ambsstaff000000 000000 all: arq.pl arq.xml > _.html scp _.html alfarrabio.um.geira.pt:public_html/img_arq/lista.html arq2.pl arq.xml > _.d1 scp _.d1 alfarrabio.um.geira.pt:aea/img_arq.d1 A=xml::dt.html $a: XML/DT.pm pod2html --title XML/DT.pm > xml::dt.html _titulos: pub.pl _10nov.xml pub.pl _10nov.xml > _titulos _10nov.xml: 10nov.sgm publico.dtd sx 10nov.sgm > _10nov.xml clean: rm -f _* XML-DT-0.63/examples/makenewexample000644 000765 000024 00000000415 10730327732 017244 0ustar00ambsstaff000000 000000 #!/usr/bin/perl @l = ; $name = "ofex". (@l+1) .".pl"; open (G,">>../MANIFEST") or die; print G "examples/$name\n"; close G; open (F,">$name ") or die; print F "#!/usr/bin/perl\n\n=head1 $name\n\n\n\=cut\n\n use XML::DT\n\n"; close F; exec("vi $name"); XML-DT-0.63/examples/pub.pl000644 000765 000024 00000000363 10730327732 015443 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = shift; %xml=( 'ARTIGO' => sub{"------------\n$c\n"}, 'TEXTO' => sub{""}, '-default' => sub{"$q - $c\n"}, '-outputenc' => 'ISO-8859-1' ); print &dt($filename,%xml); XML-DT-0.63/examples/publico.dtd000644 000765 000024 00000000401 11411137227 016436 0ustar00ambsstaff000000 000000 XML-DT-0.63/examples/README000644 000765 000024 00000001214 10730327732 015174 0ustar00ambsstaff000000 000000 XML::DT examples A simple example using xml::dt ex.xml - a simple xml file (use ex1.pl ex.xml) ex1.pl - perl program to process it Generation of a html page with an index for a image archive see also http://alfarrabio.um.geira.pt/~jj/img_arq arq.pl - perl program (use make) arq.xml - xml arquive file makefile - example using recursive use of XML::DT ex2.pl - a more complex example (use ex2.pl ex.xml) example using SGML, sx and XML::DT 10nov.sgm - SGML file publico.dtd - DTD _10nov.sgm - xml translation (sx 10nov.sgm > ...) _titulos - make _titulos pub.pl - XML-DT-0.63/examples/XPath/000755 000765 000024 00000000000 12124147445 015342 5ustar00ambsstaff000000 000000 XML-DT-0.63/examples/XPath/ex1.pl000644 000765 000024 00000000575 10730327732 016403 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use lib qw(../..); use XML::DT ; my $filename = 'ex1.xml'; # simple complete paths %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, # 'ccc' => sub{"$q:$c"}, '/aaa' => sub{print "$c";}, # 'ddd' => sub{"$q:$c"}, # 'bbb' => sub{"$q:$c"}, # 'eee' => sub{"$q:$c"}, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex1.xml000644 000765 000024 00000000325 10730327732 016561 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd XML-DT-0.63/examples/XPath/ex2.pl000644 000765 000024 00000000577 10730327732 016406 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use lib qw(../..); use XML::DT ; my $filename = 'ex2.xml'; # pending paths %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{"<$q>$c"}, # 'ccc' => sub{"$q:$c"}, '//ddd/bbb' => sub{print "$c";toxml}, # 'ddd' => sub{"$q:$c"}, # 'bbb' => sub{"$q:$c"}, # 'eee' => sub{"$q:$c"}, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex2.xml000644 000765 000024 00000000346 10730327732 016565 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd/bbb XML-DT-0.63/examples/XPath/ex3.pl000644 000765 000024 00000000550 10730327732 016376 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = 'ex3.xml'; # Paths containing * %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{ ""}, # 'ccc' => sub{"$q:$c"}, '//*/*/bbb' => sub{print "$c\n";toxml}, # 'ddd' => sub{"$q:$c"}, # 'bbb' => sub{"$q:$c"}, # 'eee' => sub{"$q:$c"}, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex3.xml000644 000765 000024 00000000346 10730327732 016566 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd/bbb XML-DT-0.63/examples/XPath/ex4.pl000644 000765 000024 00000000555 10730327732 016404 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = 'ex4.xml'; # tests atribute with name %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{ ""}, # 'ccc' => sub{"$q:$c"}, '//*[@id]' => sub{print "$c\n";toxml}, # 'ddd' => sub{"$q:$c"}, # 'bbb' => sub{"$q:$c"}, # 'eee' => sub{"$q:$c"}, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex4.xml000644 000765 000024 00000000364 10730327732 016567 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd/bbb XML-DT-0.63/examples/XPath/ex5.pl000644 000765 000024 00000000576 10730327732 016410 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = 'ex5.xml'; # tests if exist @* atribute or not(@*) %handler=( # '-outputenc' => 'ISO-8859-1', # '-default' => sub{ ""}, # 'ccc' => sub{"$q:$c"}, '//*[not(@*)]' => sub{print "$c\n";toxml}, # 'ddd' => sub{"$q:$c"}, # 'bbb' => sub{"$q:$c"}, # 'eee' => sub{"$q:$c"}, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex5.xml000644 000765 000024 00000000364 10730327732 016570 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd/bbb XML-DT-0.63/examples/XPath/ex6.pl000644 000765 000024 00000000447 10730327732 016406 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = "ex6.xml";; # Test comparasion of atribute with string... # tests the normalize-space function %handler=( '-inputenc' => 'ISO-8859-1', '//*[normalize-space(@id) = "a"]' => sub{print "$c\n";toxml}, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex6.xml000644 000765 000024 00000000366 10730327732 016573 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd/bbb XML-DT-0.63/examples/XPath/ex7.pl000644 000765 000024 00000000416 10730327732 016403 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = "ex7.xml";; # Test the name() # tests the starts_with and the contains %handler=( '-inputenc' => 'ISO-8859-1', '//*[not(contains(name(),"c"))]' => sub{print "$c\n";toxml}, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex7.xml000644 000765 000024 00000000367 10730327732 016575 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd/bbb XML-DT-0.63/examples/XPath/ex8.pl000644 000765 000024 00000000425 10730327732 016404 0ustar00ambsstaff000000 000000 #!/usr/bin/perl use XML::DT ; my $filename = "ex8.xml";; # tests number comparasion and string-length function %handler=( '-inputenc' => 'ISO-8859-1', '//*[string-length(name())<2]' => sub{ print "$c\n";toxml }, ); pathdt($filename,%handler); print "\n"; XML-DT-0.63/examples/XPath/ex8.xml000644 000765 000024 00000000362 10730327732 016571 0ustar00ambsstaff000000 000000 Texto dentro de /aaa/bbb Texto dentro de /aaa Texto dentro de /aaa/bbb/ddd/eee Texto dentro de /aaa/bbb/ddd/bbb