The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
use strict;
use utf8;
use Test::More 'tests' => 1301;
use Encode;

BEGIN { 
	use_ok 'Acme::Nyaa';
	use_ok 'Acme::Nyaa::Ja';
}
sub e { 
	my $text = shift; 
	my $char = shift || q();

	Encode::from_to( $text, $char, 'utf8' ) if $char;
	utf8::encode $text if utf8::is_utf8 $text;
	return $text;	
}

my $nekotext = 't/cat-related-text.ja.txt';
my $textlist = [];
my $langlist = [ qw|af ar de el en es fa fi fr he hi id is la pt ru th tr zh| ];
my $encoding = [ qw|euc-jp 7bit-jis shift-jis| ];
my $cmethods = [ 'new', 'reckon', 'toutf8', 'utf8to' ];
my $imethods = [ 
	'cat', 'neko', 'nyaa', 'straycat',
	'language', 'findobject', 'objects', 'object',
];
my $sabatora = undef;

$sabatora = Acme::Nyaa->new( 'language' => 'ja' );
isa_ok( $sabatora, 'Acme::Nyaa' );
is( $sabatora->language, 'ja', '->language() = ja' );

$sabatora = Acme::Nyaa::Ja->new;
isa_ok( $sabatora, 'Acme::Nyaa::Ja' );
isa_ok( $sabatora->new, 'Acme::Nyaa::Ja' );
isa_ok( $sabatora->object, 'Acme::Nyaa::Ja' );
isa_ok( $sabatora->objects, 'Acme::Nyaa::Ja' );
isa_ok( $sabatora->findobject, 'Acme::Nyaa::Ja' );
is( $sabatora->language, 'ja', '->language() = ja' );
is( $sabatora->reckon( '猫' ), 'utf8', '->reckon() = utf8' );

can_ok( 'Acme::Nyaa::Ja', @$cmethods );
can_ok( 'Acme::Nyaa::Ja', @$imethods );

ok( -T $nekotext, sprintf( "%s is textfile", $nekotext ) );
ok( -r $nekotext, sprintf( "%s is readable", $nekotext ) );
open( my $fh, '<', $nekotext ) || die 'cannot open '.$nekotext;
$textlist = [ <$fh> ];
ok( scalar @$textlist, sprintf( "%s have %d lines", $nekotext, scalar @$textlist ) );
close $fh;

foreach my $f ( 0, 1 )
{
	foreach my $u ( @$textlist )
	{
		my $label = $f ? '->cat(utf8-flagged)' : '->cat(utf8)';
		my ($text0, $text1, $text2, $text3, $text4);

		$text0 = $u; chomp $text0;
		utf8::decode( $text0 ) if $f;

		$text1 = $sabatora->cat( \$text0 );
		ok( length $text1 >= length $text0, 
			sprintf( "[1] %s: %s => %s", $label, e($text0), e($text1) ) );

		$text2 = $sabatora->cat( \$text1 );
		ok( length $text2 >= length $text1, sprintf( "[2] %s", $label ) );

		$label = $f ? '->neko(utf8-flagged)' : '->neko(utf8)';
		$text3 = $sabatora->neko( \$text0 );
		ok( length $text3 >= length $text0, 
			sprintf( "[1] %s: %s => %s", $label, e($text0), e($text3) ) );

		$text4 = $sabatora->neko( \$text3 );
		is( $text4, $text3, sprintf( "[2] %s", $label ) );
	}
}

foreach my $e ( @$encoding )
{
	foreach my $t ( @$textlist )
	{
		my $label = sprintf( "->cat(%s)", $e );
		my ($text0, $text1, $text2, $text3, $text4);

		$text0 = $t; chomp $text0;
		Encode::from_to( $text0, 'utf8', $e );

		$text1 = $sabatora->cat( \$text0 );
		ok( length $text1 >= length $text0, 
			sprintf( "[1] %s: %s => %s", $label, e($text0,$e), e($text1,$e) ) );

		$text2 = $sabatora->cat( \$text1 );
		ok( length $text2 >= length $text1, sprintf( "[2] %s", $label ) );

		$label = sprintf( "->neko(%s)", $e );
		$text3 = $sabatora->neko( \$text0 );
		ok( length $text3 >= length $text0, 
			sprintf( "[1] %s: %s => %s", $label, e($text0,$e), e($text3,$e) ) );

		$text4 = $sabatora->neko( \$text3 );
		is( $text4, $text3, sprintf( "[2] %s", $label ) );
	}
}

foreach my $l ( @$langlist )
{
	$nekotext = sprintf( "t/cat-related-text.%s.txt", $l );
	ok( -T $nekotext, sprintf( "%s is textfile", $nekotext ) );
	ok( -r $nekotext, sprintf( "%s is readable", $nekotext ) );

	open( my $fh, '<', $nekotext ) || die 'cannot open '.$nekotext;
	$textlist = [ <$fh> ];
	ok( scalar @$textlist, 
		sprintf( "%s have %d lines", $nekotext, scalar @$textlist ) );
	close $fh;

	foreach my $e ( @$textlist )
	{
		my $label = sprintf( "->cat(%s)", $l );
		my ($text0, $text1, $text2, $text3, $text4);

		$text0 = $e;
		$text1 = $sabatora->cat( \$text0 );
		is( $text1, $text0,  
			sprintf( "[1] %s: %s => %s", $label, e($text0), e($text1) ) );
	}
}

foreach my $e ( '', '猫', 'ねこ', 'ネコ' )
{
	$nekotext = $sabatora->nyaa($e);
	ok( length $nekotext, sprintf( "->nyaa(%s) => %s", e($e), e($nekotext) ) );
}

$nekotext = 't/a-part-of-i-am-a-cat.ja.txt';
ok( -T $nekotext, sprintf( "%s is textfile", $nekotext ) );
ok( -r $nekotext, sprintf( "%s is readable", $nekotext ) );

open( $fh, '<', $nekotext ) || die 'cannot open '.$nekotext;
$textlist = [ <$fh> ];
ok( scalar @$textlist, 
	sprintf( "%s have %d lines", $nekotext, scalar @$textlist ) );
close $fh;

my $text0 = join( '', @$textlist );
my $text1 = $sabatora->straycat( $textlist );
my $text2 = $sabatora->straycat( \$text0 );

ok( length( $text1 ) > length( $text0 ) );
ok( length( $text2 ) > length( $text0 ) );