view release on metacpan or  search on metacpan

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

=head1 NAME

App::url - format a URL according to a sprintf-like template

=head1 SYNOPSIS

	$ url '%h' http://www.example.com/a/b/c
	www.example.com

	$ url '%H' http://www.example.com/a/b/c
	www

	$ url '%P' http://www.example.com/a/b/c
	/a/b/c

=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

=item * C<%p> - the port

=item * C<%q> - the query string

=item * C<%s> - the scheme

=item * C<%S> - the public suffix

=item * C<%u> - the complete URL

=item * C<%U> - the username of the userinfo portion

=back

There are also some bonus formats unrelated to the URL:

=over 4

=item * C<%n> - newline

=item * C<%t> - tab

=item * C<%%> - literal percent

=back

=head2 Methods

=over 4

=item * run( TEMPLATE, ARRAY )

Format each URL in ARRAY according to TEMPLATE and return an array
reference

=back

=head1 COPYRIGHT

Copyright © 2020-2025, brian d foy, all rights reserved.

=head1 LICENSE

You can use this code under the terms of the Artistic License 2.

=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 {
			if(    $V->[0]->protocol eq 'http'  ) {  80 }
			elsif( $V->[0]->protocol eq 'https' ) { 443 }
			};
	     },
	P   => sub ( $w, $v, $V, $l ) { $V->[0]->password  },
	'q' => sub ( $w, $v, $V, $l ) { $V->[0]->query     },
	's' => sub ( $w, $v, $V, $l ) { $V->[0]->protocol  },

	S   => sub ( $w, $v, $V, $l ) {
		state $rc = eval { require Net::PublicSuffixList };
		unless( $rc ) {
			carp "%${l} requires Net::PublicSuffixList\n";
			return;
			}
		state $psl = Net::PublicSuffixList->new;
		my $hash = $psl->split_host( $V->[0]->host );
		$hash->{suffix};