view release on metacpan or  search on metacpan

t/30-span.t  view on Meta::CPAN

         call [ cmp => "123" ], 0;
         call encoding => "UTF-16LE";
      },
      'UTF16LE';
   is secret("\xEF\xBB\xBF123")->span->set_up_us_the_bom,
      object {
         call [ cmp => "123" ], 0;
         call encoding => "UTF-8";
      },
      'UTF8';
};

subtest copy_iso8859 => sub {
   my $s= secret("abcdef")->span;
   is $s->copy,
      object {
         call stringify => '[REDACTED]';
         call length => 6;
         call sub { shift->span->starts_with("abcdef") } => T;
      },
      'copy';
   my $str= 'will get overwritten';
   $s->copy_to($str);
   is( $str, "abcdef", "copy to scalar" );
   $s->append_to($str);
   is( $str, "abcdefabcdef", "append to scalar" );

   my $buf= secret("will get overwritten");
   $s->copy_to($buf);
   is $buf,
      object {
         call stringify => '[REDACTED]';
         call length => 6;
         call [ memcmp => "abcdef" ] => 0;
      },
      'copy to secret';
   $s->append_to($buf);
   is $buf,
      object {
         call stringify => '[REDACTED]';
         call length => 12;
         call [ memcmp => "abcdefabcdef" ] => 0;
      },
      'append to secret';

   # Try to specify something out of bounds
   $s->buf->length(4);
   is( $s->length, 6, 'span is 6 bytes' );
   ok( !eval { $s->copy }, 'copy died' );
   like( $@, qr/ends beyond buffer/, 'error message' );

   # Copy empty span
   my $x;
   secret("-")->span(0,0)->copy_to($x);
   is( $x, '', 'empty string from empty span' );
   secret->span->copy_to($x);
   is( $x, '', 'empty string from buffer lacking any storage' );
};

subtest copy_widechar => sub {
   my $unicode= "\0\x{10}\x{100}\x{1000}\x{10000}\x{10FFFD}";

   my $utf8= encode('UTF-8', $unicode);
   my $buf= 'will get overwritten';
   secret($utf8)->span(encoding => UTF8)->copy_to($buf);
   is( $buf, $unicode, 'round trip through UTF-8' )
      or note map escape_nonprintable($_)."\n", $utf8, $buf;
   secret($utf8)->span(encoding => UTF8)->append_to($buf);
   is( $buf, $unicode x 2, 'round trip through UTF-8, append' )
      or note map escape_nonprintable($_)."\n", $utf8, $buf;

   my $utf16le= encode('UTF-16LE', $unicode);
   $buf= '';
   secret($utf16le)->span(encoding => UTF16LE)->copy_to($buf);
   is( $buf, $unicode, 'round trip through UTF-16LE' )
      or diag explain $buf;

   my $utf16be= encode('UTF-16BE', $unicode);
   $buf= '';
   secret($utf16be)->span(encoding => UTF16BE)->copy_to($buf);
   is( $buf, $unicode, 'round trip through UTF-16BE' )
      or diag explain $buf;
};

subtest copy_hex => sub {
   my $s= secret("\x01\x02\x03");
   is( $s->span->copy(encoding => HEX),
      object {
         call sub { shift->span->starts_with("010203") }, T;
         call length => 6;
      },
      'convert to hex' );

   $s= secret("010203");
   is( $s->span(encoding => HEX)->copy(encoding => ISO8859_1),
      object {
         call sub { shift->span->starts_with("\x01\x02\x03") }, T;
         call length => 3;
      },
      'convert from hex' );
};

subtest copy_base64 => sub {
   for my $str (qw( 123 three_times4 remainder1 remainder_2 )) {
      my $b64= encode_base64($str, '');
      my $tmp;
      secret($str)->span->copy_to($tmp, encoding => BASE64);
      is( $tmp, $b64, "encode $str" );
      undef $tmp;
      secret($b64)->span(encoding => BASE64)->copy_to($tmp, encoding => ISO8859_1);
      is( $tmp, $str, "decode $b64" );
   }
};

subtest codepointcmp => sub {
   is( secret("A")->span cmp secret("B")->span, -1, 'A cmp B' );
   is( secret("\xFF")->span cmp "\x{100}", -1, '0xFF cmp 0x100' );

   my $unicode= "\0\x{10}\x{100}\x{1000}\x{10000}\x{10FFFD}";
   my $utf16= encode('UTF-16LE', $unicode);
   is( secret($utf16)->span(encoding => 'UTF16LE') cmp $unicode, 0, 'utf16 cmp utf8' );
};

subtest clean_namespace => sub {
   my $ns= \%Crypt::SecretBuffer::Span::;
   my @public= qw(
      append_to buf buffer can clone cmp consume_bom copy copy_to default_trim_regex encoding
      ends_with last_error len length lim ltrim memcmp new parse parse_asn1_der_length
      parse_base128be parse_base128le parse_lenprefixed pos rparse rtrim scan set_up_us_the_bom
      starts_with subspan trim
   );
   is( [ grep /^[a-z]/ && $_ ne 'isa', sort keys %$ns ], \@public )
      or diag explain $ns;
};

done_testing;