1use strict; 2#use warnings; 3 4package RDF::Notation3::Template::TXML; 5 6 7use RDF::Notation3; 8 9############################################################ 10 11@RDF::Notation3::Template::TXML::ISA = qw(RDF::Notation3); 12 13 14sub _process_statement { 15 my ($self, $subject, $properties) = @_; 16 17 $subject = $self->_expand_prefix($subject); 18 $subject =~ s/^<(.*)>$/$1/; 19 20 my $prev; 21 my $j = 0; 22 foreach (@$properties) { 23 24 if ($_->[0] ne 'i') { 25 26 if ($j == 0 or $prev eq 'i') { 27 my @attr = (); 28 29 # nodeID is used for blank nodes 30 if ($subject =~ /^$self->{ansuri}(.*)$/) { 31 push @attr, ['rdf:nodeID' => "$self->{nIDpref}$1"]; 32 } else { 33 push @attr, ['rdf:about' => $subject]; 34 } 35 36 $self->doStartElement('rdf:Description', \@attr); 37 } 38 39 my ($attr, $pred) = $self->_process_predicate($_->[0]); 40 $pred =~ s/^:(.*)$/$1/; 41 42 for (my $i = 1; $i < scalar @$_; $i++) { 43 $_->[$i] = $self->_expand_prefix($_->[$i]); 44 45 my @attr = @$attr; 46 my $val = ''; 47 48 # URI 49 if ($_->[$i] =~ s/^<(.*)>$/$1/) { 50 # nodeID is used for blank nodes 51 if ($_->[$i] =~ /^$self->{ansuri}(.*)$/) { 52 push @attr, ['rdf:nodeID' => "$self->{nIDpref}$1"]; 53 } else { 54 push @attr, ['rdf:resource' => $_->[$i]]; 55 } 56 57 # string2 58 } elsif ($_->[$i] =~ s/^"""(.*)"""$/$1/s) { 59 $val = $_->[$i]; 60 61 # string1 62 } elsif ($_->[$i] =~ s/^"(.*)"$/$1/) { 63 $val = $_->[$i]; 64 65 } else { 66 $self->_do_error(402, $_->[$i]); 67 } 68 69# # URI 70# $_->[$i] =~ s/^<(.*)>$/$1/ and 71# push @attr, ['rdf:resource' => $_->[$i]]; 72# # string2 73# $_->[$i] =~ s/^"""(.*)"""$/$1/s and 74# $val = $_->[$i]; 75# # string1 76# $_->[$i] =~ s/^"(.*)"$/$1/ and 77# $val = $_->[$i]; 78 79 # escaping literals 80 $val =~ s/</</g; 81 $val =~ s/>/>/g; 82 $val =~ s/&/&/g; 83 84 $self->doElement($pred, \@attr, $val); 85 $self->{count}++; 86 } 87 88 if ($j == scalar @$properties - 1 or 89 ($properties->[$j+1]->[0] eq 'i')) { 90 $self->doEndElement('rdf:Description'); 91 } 92 93 } else { 94 # inverse mode (is, <-) 95 for (my $i=2; $i < scalar @$_; $i++) { 96 $_->[$i] = $self->_expand_prefix($_->[$i]); 97 $_->[$i] =~ s/^<(.*)>$/$1/; 98 99 my @attr = (); 100 push @attr, [about => $_->[$i]]; 101 $self->doStartElement('rdf:Description', \@attr); 102 103 my ($attr, $pred) = $self->_process_predicate($_->[1]); 104 my @attr2 = @$attr; 105 $pred =~ s/^:(.*)$/$1/; 106 push @attr2, ['rdf:resource' => $subject]; 107 108 $self->doElement($pred, \@attr2, ''); 109 $self->{count}++; 110 111 $self->doEndElement('rdf:Description'); 112 } 113 } 114 $prev = $_->[0]; 115 $j++; 116 } 117} 118 119 120sub _expand_prefix { 121 my ($self, $qname) = @_; 122 123 foreach (keys %{$self->{ns}->{$self->{context}}}) { 124 $qname =~ s/^$_:(.*)$/<$self->{ns}->{$self->{context}}->{$_}$1>/; 125 } 126 127 if ($qname =~ /^([_a-zA-Z]\w*)*:[a-zA-Z]\w*$/) { 128 $self->_do_error(106, $qname); 129 } 130 131 return $qname; 132} 133 134 135sub _process_predicate { 136 my ($self, $name) = @_; 137 my @attr = (); 138 139 my $p = ''; 140 my $pushed = 0; 141 if ($name =~ /^([_a-zA-Z]\w*)*:[a-zA-Z]\w*$/) { 142 $p = $1; 143 144 } else { # not a QName - must be turned to QName 145 my $qnamed = 0; 146 147 # checking if the NS already exists 148 foreach (keys %{$self->{ns}->{$self->{context}}}) { 149 my $ns = _escape_ns($self->{ns}->{$self->{context}}->{$_}); 150 if ($name =~ s/^<$ns([a-zA-Z]\w*)>$/$_:$1/) { 151 $qnamed = 1; 152 $p = $_; 153 last; 154 } 155 } 156 # checking out hard-coded NS 157 unless ($qnamed) { 158 foreach (keys %{$self->{hardns}}) { 159 my $ns = _escape_ns($self->{hardns}->{$_}->[1]); 160 if ($name =~ s/^<$ns([a-zA-Z]\w*)>$/$self->{hardns}->{$_}->[0]:$1/) { 161 $p = $self->{hardns}->{$_}->[0]; 162 $self->{ns}->{$self->{context}}->{$p} = 163 $self->{hardns}->{$_}->[1]; 164 $qnamed = 1; 165 $p = $self->{hardns}->{$_}->[0]; 166 last; 167 } 168 } 169 } 170 # inventing new NS 171 unless ($qnamed) { 172 my $i = 1; 173 my $pref = 'pref'; 174 while ($self->{ns}->{$self->{context}}->{$pref}) { 175 $pref = "$pref$i"; 176 $i++; 177 } 178 if ($name =~ s/^<(.*?)([a-zA-Z]\w*)>$/$pref:$2/) { 179 push @attr, ["xmlns:$pref" => $1]; 180 $qnamed = 1; 181 $pushed = 1; 182 } 183 } 184 $self->_do_error(401, $name) unless $qnamed; 185 } 186 187 unless ($pushed) { 188 if ($p) { 189 push @attr, ["xmlns:$p" => $self->{ns}->{$self->{context}}->{$p}]; 190 $self->_do_error(106, $name) 191 unless $self->{ns}->{$self->{context}}->{$p}; 192 } else { 193 push @attr, ["xmlns" => $self->{ns}->{$self->{context}}->{''}]; 194 $self->_do_error(106, $name) 195 unless $self->{ns}->{$self->{context}}->{''}; 196 } 197 } 198 199 return (\@attr, $name); 200} 201 202 203sub _escape_ns { 204 my $ns = shift; 205 206 $ns =~ s/\+/\\+/; 207 $ns =~ s/\*/\\*/; 208 $ns =~ s/\?/\\?/; 209 210 return $ns; 211} 212 213 2141; 215 216 217__END__ 218# Below is a documentation. 219 220=head1 NAME 221 222RDF::Notation3::Template::TXML - an RDF/XML converter template 223 224=head1 LICENSING 225 226Copyright (c) 2001 Ginger Alliance. All rights reserved. This program is free 227software; you can redistribute it and/or modify it under the same terms as 228Perl itself. 229 230=head1 AUTHOR 231 232Petr Cimprich, petr@gingerall.cz 233 234=head1 SEE ALSO 235 236perl(1), RDF::Notation3. 237 238=cut 239