File Coverage

blib/script/url

Criterion	Covered	Total	%
statement	20	20	100.0
branch	2	4	50.0
condition	1	3	33.3
subroutine	4	4	100.0
pod			n/a
total	27	31	87.1

#!/usr/local/bin/perl
use v5.26;

use App::url 1.009;

=encoding utf8

=head1 NAME

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

=head1 SYNOPSIS

	# format as just the host
	$ url '%H' http://www.example.com/a/b/c
	www.example.com

	# handle more than one.
	$ url '%H' http://www.example.com/a/b/c http://www.github.com
	www.example.com
	www.github.com

	# get the path
	$ url '%P' http://www.example.com/a/b/c
	/a/b/c

=head1 DESCRIPTION

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

=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

=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

use Encode qw(decode encode);
use I18N::Langinfo qw(langinfo CODESET);

my $langinfo = langinfo(CODESET);
$langinfo = "cp-$langinfo" if( $^O eq 'MSWin32' and $langinfo =~ /\A\d+\z/a );

@ARGV = map { decode( $langinfo, $_ ) } @ARGV;

my $results = App::url->run( @ARGV );
exit if $results->@* == 0;

binmode STDOUT, ':raw';
say join "\n", map { encode( $langinfo, $_ ) } $results->@*;