view release on metacpan or  search on metacpan

t/formatter.t  view on Meta::CPAN

subtest ihost => sub {
	my $env = join "\n", map { no warnings; "$_: $ENV{$_}" }
		qw( LC_ALL LANG LANGUAGE );
	diag( $env );

	my @tests = (
		[ qw( http://www.example.com/a/b/c www.example.com     ) ],
		[ qw( http://bücher.ch/a/b/c       xn--bcher-kva.ch    ) ],
		[ qw( http://mañana.com/a/b/c      xn--maana-pta.com   ) ],
		[ qw( http://☃-⌘.com/a/b/c         xn----dqo34k.com    ) ],
		[ qw( http://éxàmple.com/a/b/c     xn--xmple-rqa5d.com ) ],
		);

	SKIP: {
		skip "Locale is not set!", scalar @tests unless length $ENV{LC_ALL};
		skip "Locale is not UTF-8!", scalar @tests unless length $ENV{LC_ALL} =~ /UTF-?8/;
		run_table( '%i', \@tests );
		}
	};

subtest port => sub {
	my @tests = (
		[ qw( http://www.example.com/a/b/c          80 ) ],
		[ qw( http://www.example.net:80/a/b/c       80 ) ],
		[ qw( http://www.example.net:8080/a/b/c   8080 ) ],
		[ qw( https://www.example.net/a/b/c        443 ) ],
		[ qw( https://www.example.net:4443/a/b/c  4443 ) ],
		);

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

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

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

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

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

subtest path => sub {
	no warnings qw( qw );

	my @tests = (
		[ qw( http://www.example.com/a/b/c       /a/b/c ) ],
		[ qw( https://www.example.net/g/h/d?xyz  /g/h/d ) ],
		[ qw( https://www.example.net/g/h/d#frag /g/h/d ) ],
		);

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

subtest fragment => sub {
	no warnings qw( qw );

	my @tests = (
		[ qw( http://www.example.com/a/b/c  ) ],
		[ qw( https://www.example.net/g/h/d?xyz  ) ],
		[ qw( https://www.example.net/g/h/d#frag frag ) ],
		);

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

subtest query => sub {
	no warnings qw( qw );

	my @tests = (
		[ qw( http://www.example.com/a/b/c                           ) ],
		[ qw( https://www.example.net/g/h/d?xyz          xyz         ) ],
		[ qw( https://www.example.net/g/h/d?xyz+abc      xyz+abc     ) ],
		[ qw( https://www.example.net/g/h/d?one=1&two=2  one=1&two=2 ) ],
		[ qw( https://www.example.net/g/h/d?one=1;two=2  one=1;two=2 ) ],
		[ qw( https://www.example.net/g/h/d#frag                     ) ],
		);

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

sub run_table ($template, $tests) {
	foreach my $test ( $tests->@* ) {
		chomp( my $output = `$program "$template" "$test->[0]"` );
		is( $output, $test->[1] // '', "Value for $test->[0] is correct" );
		}
	}


done_testing();