Commits

Toby Inkster  committed a8b1a7b

fix base64 and hex lengths

  • Participants
  • Parent commits d6d8e98

Comments (0)

Files changed (2)

File devel.w3c-testing/convert-test-cases.pl

 use warnings;
 use utf8;
 
-use Test::DescribeMe qw(extended);
 use Test::More;
 use Test::TypeTiny;
 
 		# XML regexes have these \c and \i things which we'll attempt to fake.
 		$facets{pattern} =~ s/\\c/(?:\$XML::RegExp::NameChar)/g;
 		$facets{pattern} =~ s/\\i/(?:\$XML::RegExp::NameChar)/g;
-		eval { $facets{pattern} = qr{^$facets{pattern}$}ms }
-		or do {
-			print $out "\tlocal \$TODO = \"could not compile regexp\";\n";
+		if ($facets{pattern} =~ /\[[^\]]+-\[/)
+		{
+			print $out "\tlocal \$TODO = \"XML Schema regexp not easily translated to Perl\";\n";
 			delete($facets{pattern});
-		};
+		}
+		else
+		{
+			eval { $facets{pattern} = qr{^$facets{pattern}$}ms } or do {
+				print $out "\tlocal \$TODO = \"could not compile regexp\";\n";
+				delete($facets{pattern});
+			}
+		}
 	}
 	
 	local $Data::Dumper::Terse  = 1;

File lib/Types/XSD.pm

 	return undef;
 }
 
+sub hex_length
+{
+	my $str = shift;
+	my $len = ($str =~ tr/0-9A-Fa-f//);
+	$len / 2;
+}
+
+sub b64_length
+{
+	my $str = shift;
+	$str =~ s/[^a-zA-Z0-9+\x{2f}=]//g;
+	my $padding = ($str =~ tr/=//);
+	(length($str) * 3 / 4) - $padding;
+}
+
 our @patterns; my $pattern_i = -1;
 my %facets = (
 	length => sub {
 		return unless exists $o->{minLength};
 		sprintf('length(%s)>=%d', $var, delete $o->{minLength});
 	},
+	lengthHex => sub {
+		my ($o, $var) = @_;
+		return unless exists $o->{length};
+		sprintf('Types::XSD::hex_length(%s)==%d', $var, delete $o->{length});
+	},
+	maxLengthHex => sub {
+		my ($o, $var) = @_;
+		return unless exists $o->{maxLength};
+		sprintf('Types::XSD::hex_length(%s)<=%d', $var, delete $o->{maxLength});
+	},
+	minLengthHex => sub {
+		my ($o, $var) = @_;
+		return unless exists $o->{minLength};
+		sprintf('Types::XSD::hex_length(%s)>=%d', $var, delete $o->{minLength});
+	},
+	lengthB64 => sub {
+		my ($o, $var) = @_;
+		return unless exists $o->{length};
+		sprintf('Types::XSD::b64_length(%s)==%d', $var, delete $o->{length});
+	},
+	maxLengthB64 => sub {
+		my ($o, $var) = @_;
+		return unless exists $o->{maxLength};
+		sprintf('Types::XSD::b64_length(%s)<=%d', $var, delete $o->{maxLength});
+	},
+	minLengthB64 => sub {
+		my ($o, $var) = @_;
+		return unless exists $o->{minLength};
+		sprintf('Types::XSD::b64_length(%s)>=%d', $var, delete $o->{minLength});
+	},
 	pattern => sub {
 		my ($o, $var) = @_;
 		return unless exists $o->{pattern};
 facet qw( pattern whiteSpace ),
 declare Boolean, as Types::Standard::StrMatch[qr{^(?:true|false|0|1)$}ism];
 
-facet qw( length minLength maxLength pattern enumeration whiteSpace ),
+facet qw( lengthB64 minLengthB64 maxLengthB64 pattern enumeration whiteSpace ),
 declare Base64Binary, as Types::Standard::StrMatch[qr{^[a-zA-Z0-9+\x{2f}=\s]+$}ism];
 
-facet qw( length minLength maxLength pattern enumeration whiteSpace ),
+facet qw( lengthHex minLengthHex maxLengthHex pattern enumeration whiteSpace ),
 declare HexBinary, as Types::Standard::StrMatch[qr{^[a-fA-F0-9]+$}ism];
 
 facet qw( pattern enumeration whiteSpace maxInclusiveFloat maxExclusiveFloat minInclusiveFloat minExclusiveFloat ),