/[suikacvs]/messaging/manakai/bin/xml-validate.pl
Suika

Diff of /messaging/manakai/bin/xml-validate.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Sun Sep 7 03:12:40 2003 UTC revision 1.2 by wakaba, Sat Sep 13 09:04:21 2003 UTC
# Line 8  my %src = ( Line 8  my %src = (
8          catalog_dtd     => 'dtd/xcatalog.dtd',          catalog_dtd     => 'dtd/xcatalog.dtd',
9          output_parsed_document => 1,          output_parsed_document => 1,
10          remove_reference => 1,          remove_reference => 1,
11            validate        => 1,
12  );  );
13  $src{output_charset} = $1 if $main::ENV{LANG} =~ /\.(\w+)/;  $src{output_charset} = $1 if $main::ENV{LANG} =~ /\.(\w+)/;
14  Getopt::Long::GetOptions (  Getopt::Long::GetOptions (
# Line 15  Getopt::Long::GetOptions ( Line 16  Getopt::Long::GetOptions (
16          q(catalog=s)    => \$src{catalog},          q(catalog=s)    => \$src{catalog},
17          q(catalog-dtd=s)        => \$src{catalog_dtd},          q(catalog-dtd=s)        => \$src{catalog_dtd},
18          q(check-error-page!)    => \$src{check_error_page},          q(check-error-page!)    => \$src{check_error_page},
19            q(dtd-external-subset=s)        => \$src{dtd_extsubset},
20          ## TODO: help          ## TODO: help
21          q(output-charset=s)     => \$src{output_charset},          q(output-charset=s)     => \$src{output_charset},
22          q(output-parsed-document!)      => \$src{output_parsed_document},          q(output-parsed-document!)      => \$src{output_parsed_document},
23          q(remove-reference!)    => \$src{remove_reference},          q(remove-reference!)    => \$src{remove_reference},
24          q(stop-with-fatal!)     => \$src{stop_with_fatal},          q(stop-with-fatal!)     => \$src{stop_with_fatal},
25            q(stop-with-vc!)        => \$src{stop_with_vc},
26            q(validate!)    => \$src{validate},
27  );  );
28  $src{uri} = shift or die "$0: No URI specified";  $src{uri} = shift or die "$0: No URI specified";
29  binmode STDOUT;  binmode STDOUT;
# Line 32  my $cwd = URI::file->new (Cwd::getcwd () Line 36  my $cwd = URI::file->new (Cwd::getcwd ()
36  $src{uri} = URI->new ($src{uri})->abs ($cwd);  $src{uri} = URI->new ($src{uri})->abs ($cwd);
37  $src{catalog} = URI->new ($src{catalog})->abs ($cwd) if $src{catalog};  $src{catalog} = URI->new ($src{catalog})->abs ($cwd) if $src{catalog};
38  $src{catalog_dtd} = URI->new ($src{catalog_dtd})->abs ($cwd) if $src{catalog_dtd};  $src{catalog_dtd} = URI->new ($src{catalog_dtd})->abs ($cwd) if $src{catalog_dtd};
39    $src{dtd_extsubset} = URI->new ($src{dtd_extsubset})->abs ($cwd) if $src{dtd_extsubset};
40    
41    my ($nswf, $nsvalid, $wf, $valid) = (1, 1, 1, 1);
42  my $catalog;  my $catalog;
43    my $eh = sub {
44                    my ($caller, $o, $error_type, $error_msg, $err) = @_;
45                    require Carp;
46                    if ($err->{raiser_type} eq 'Message::Markup::XML::Validator') {
47                      $error_msg = $err->{node_path} . ': ' . $error_msg if $err->{node_path};
48                      $error_msg = 'Document <'.$err->{uri}.'>: ' . $error_msg if $err->{uri};
49                    }
50                    if (($src{stop_with_fatal}
51                     && {qw/fatal 1 wfc 1 nswfc 1/}->{$error_type->{level}})
52                     || ($src{stop_with_vc}
53                     && {qw/vc 1 nsvc 1/}->{$error_type->{level}})) {
54                      local $Carp::CarpLevel = 1;
55                      Carp::croak ('{'.$error_type->{level}.'} '.$error_msg);
56                    } else {
57                      local $Carp::CarpLevel = 1;
58                      Carp::carp ('{'.$error_type->{level}.'} '.$error_msg);
59                    }
60                    
61                    if ($error_type->{level} eq 'wfc') { $wf = 0 ; $valid = 0 }
62                    elsif ($error_type->{level} eq 'vc') { $valid = 0 }
63                    elsif ($error_type->{level} eq 'nswfc') { $nswf = 0 ; $nswf = 0 }
64                    elsif ($error_type->{level} eq 'nsvc') { $nsvalid = 0 }
65                    
66                    return 0;
67            };
68  my $parser = Message::Markup::XML::Parser->new (option => {  my $parser = Message::Markup::XML::Parser->new (option => {
69          uri_resolver => sub {          uri_resolver => sub {
70                  my ($self, $parser, $decl, $p) = @_;                  my ($self, $parser, $decl, $p) = @_;
# Line 54  my $parser = Message::Markup::XML::Parse Line 85  my $parser = Message::Markup::XML::Parse
85                  print STDERR "Retriving external entity <$p->{uri}>...\n";                  print STDERR "Retriving external entity <$p->{uri}>...\n";
86                  return 1;                  return 1;
87          },          },
88          error_handler => sub {          error_handler => $eh,
                 my ($caller, $o, $error_type, $error_msg) = @_;  
                 require Carp;  
                 if ($src{stop_with_fatal}  
                  && {qw/fatal 1 wfc 1/}->{$error_type->{level}}) {  
                   $Carp::CarpLevel = 1;  
                   Carp::croak ('{'.$error_type->{level}.'} '.$error_msg);  
                 } else {  
                   $Carp::CarpLevel = 1;  
                   Carp::carp ('{'.$error_type->{level}.'} '.$error_msg);  
                 }  
                 return 0;  
         },  
89  });  });
90    
91  my $p = {uri => $src{uri}, base_uri => $src{base_uri}};  my $p = {uri => $src{uri}, base_uri => $src{base_uri}};
# Line 83  if ($p->{error}->{no_data}) { Line 102  if ($p->{error}->{no_data}) {
102                         t => ['#document', $p->{uri}, $p->{error}->{reason_text}]);                         t => ['#document', $p->{uri}, $p->{error}->{reason_text}]);
103  } else {  } else {
104    $parser->option (document_entity_base_uri => $p->{base_uri});    $parser->option (document_entity_base_uri => $p->{base_uri});
105    my $doc = $parser->parse_text ($p->{text}, $o, entMan => $em);    my $doc = $parser->parse_text ($p->{text}, $o,
106                                     entMan => $em,
107                                     alt_dtd_external_subset => $src{dtd_extsubset});
108      
109      if ($src{validate}) {
110        require Message::Markup::XML::Validate;
111        my $validator = Message::Markup::XML::Validate->new (option => {
112          error_handler => $eh,
113        });
114        $valid &= $validator->validate ($doc, entMan => $em);
115      } else {
116        $valid = 0;
117      }
118      
119    if ($src{output_parsed_document}) {    if ($src{output_parsed_document}) {
120      if ($src{remove_reference}) {      if ($src{remove_reference}) {
121        $doc->remove_references;        $doc->remove_references;
# Line 91  if ($p->{error}->{no_data}) { Line 123  if ($p->{error}->{no_data}) {
123      }      }
124      print $doc;      print $doc;
125    }    }
126      
127      print STDERR qq(<$p->{uri}> is @{[
128            $valid ? ($nsvalid ? 'a namespace valid'
129                               : ($nswf ? 'a valid and namespace well-formed' : 'a valid')) :
130            $wf ? ($nswf ? 'a namespace well-formed' : 'a well-formed') :
131            'not a well-formed'
132      ]} XML document\n);
133  }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24