view release on metacpan or  search on metacpan

t/formatter.t  view on Meta::CPAN

use v5.26;
use utf8;
use Mojo::Base -strict, -signatures;
use open qw(:std :utf8);
use Test::More 1;

use File::Spec::Functions;

my $program = catfile( qw( blib script url ) );

subtest sanity => sub {
	my $class = 'App::url';
	use_ok( $class );
	can_ok( $class, 'run' );
	ok( -e $program, 'The program exists' );
	like( `$^X -c $program 2>&1`, qr/syntax OK/, "$program compiles" );
	};

subtest basic => sub {
	my $url = 'http://www.example.com/a/b/c?o=987&p=234';
	my $output;

	subtest newline => sub {
		chomp( $output = `$program "%n" "$url"` );
		is( $output, "\n", "Value for newline is correct" );

		chomp( $output = `$program "abc%ndef" "$url"` );
		is( $output, "abc\ndef", "Value for newline is correct" );
		};
	subtest tab => sub {
		chomp( $output = `$program "%t" "$url"` );
		is( $output, "\t", "Value for tab is correct" );

		chomp( $output = `$program "456%t987" "$url"` );
		is( $output, "456\t987", "Value for tab is correct" );
		};
	subtest percent => sub {
		chomp( $output = `$program "%%" "$url"` );
		is( $output, '%', "Value for percent is correct" );

		chomp( $output = `$program "%%" "$url"` );
		is( $output, '%', "Value for percent is correct" );
		};

	};

subtest unknown => sub {
	my $url = 'http://www.example.com/a/b/c?o=987&p=234';
	my $output;

	foreach my $specifier ( qw(X g d) ) {
		chomp( $output = `$program "%$specifier" "$url" 2>&1` );
		like( $output, qr/Invalid specifier/, "Warning for unknown specifier <$specifier>" );
		}
	};

subtest url => sub {
	my @tests = map { [ lc $_, lc $_ ] } qw(
		http://www.example.com/a/b/c
		HTTP://www.example.com/a/b/c
		https://www.example.net/a/b/c
		HtTpS://www.example.net/a/b/c
		ftp://briandfoy.github.io/a/b/c
		mailto:github.com/a/b/c
		);

	run_table( '%u', \@tests )
	};

subtest scheme => sub {
	my @tests = (
		[ qw( http://www.example.com/a/b/c    http  ) ],
		[ qw( HTTP://www.example.com/a/b/c    http  ) ],
		[ qw( https://www.example.net/a/b/c   https ) ],
		[ qw( HtTpS://www.example.net/a/b/c   https ) ],
		[ qw( ftp://briandfoy.github.io/a/b/c ftp   ) ],
		[ qw( mailto:github.com/a/b/c mailto        ) ],
		);

	run_table( '%s', \@tests )
	};

subtest host => sub {
	my @tests = (
		[ qw( http://www.example.com/a/b/c      www.example.com     ) ],
		[ qw( http://www.example.net/a/b/c      www.example.net     ) ],
		[ qw( http://briandfoy.github.io/a/b/c  briandfoy.github.io ) ],
		[ qw( http://github.com/a/b/c           github.com          ) ],
		[ qw( http://user:pass@github.com/a/b/c github.com          ) ],
		);

	run_table( '%h', \@tests )
	};

subtest host_no_domain => sub {
	my @tests = (
		[ qw( http://www.example.com/a/b/c         www       ) ],
		[ qw( http://foo.www.foo.example.net/a/b/c foo       ) ],
		[ qw( http://briandfoy.github.io/a/b/c     briandfoy ) ],
		);

	run_table( '%H', \@tests )