App-url

 view release on metacpan or  search on metacpan

lib/App/url.pm  view on Meta::CPAN

=head1 DESCRIPTION

Decompose the URL and reformat it according to

=head2 The formats

=over 4

=item * C<%a> - the path

=item * C<%f> - the fragment

=item * C<%h> - the hostname, with domain info

=item * C<%H> - the hostname without domain info

=item * C<%i> - the hostname in punycode

=item * C<%I> - space-separated list of IP addresses for the host

=item * C<%P> - the password of the userinfo portion

lib/App/url.pm  view on Meta::CPAN

=cut

no warnings 'uninitialized';

# $w - width of field
# $v - value that corresponds to position in template
# $V - list of all values
# $l - letter
my $formatter = String::Sprintf->formatter(
	a   => sub ( $w, $v, $V, $l ) { $V->[0]->path      },
	f   => sub ( $w, $v, $V, $l ) { $V->[0]->fragment  },
	h   => sub ( $w, $v, $V, $l ) { $V->[0]->host      },
	H   => sub ( $w, $v, $V, $l ) { ( split /\./, $V->[0]->host )[0] },
	i   => sub ( $w, $v, $V, $l ) { $V->[0]->ihost     },
	I   => sub ( $w, $v, $V, $l ) {
		state $rc = require Socket;
		my @addresses = gethostbyname( $V->[0]->host );
		@addresses = map { Socket::inet_ntoa($_) } @addresses[4..$#addresses];
		"@addresses";
		},
	p   => sub ( $w, $v, $V, $l ) { $V->[0]->port // do {

script/url  view on Meta::CPAN

Decompose the URL and reformat it according to a template.

=head2 The formats

=over 4

=item * C<%a> - the path

=item * C<%A> - the addresses

=item * C<%f> - the fragment

=item * C<%h> - the hostname, with domain info

=item * C<%H> - the hostname without domain info

=item * C<%i> - the hostname in punycode

=item * C<%I> - space-separated list of IP addresses for the host

=item * C<%P> - the password of the userinfo portion

t/formatter.t  view on Meta::CPAN

	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" );
		}