This file is indexed.

/usr/share/perl5/URI/FromHash.pm is in liburi-fromhash-perl 0.05-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
package URI::FromHash;

use strict;
use warnings;

our $VERSION = '0.05';

use Params::Validate qw( validate SCALAR ARRAYREF HASHREF );
use URI 1.68;

use Exporter qw( import );

our @EXPORT_OK = qw( uri uri_object );

my %BaseParams = (
    scheme   => { type => SCALAR, optional => 1 },
    username => { type => SCALAR, optional => 1 },
    password => { type => SCALAR, default  => q{} },
    host     => { type => SCALAR, optional => 1 },
    port     => { type => SCALAR, optional => 1 },
    path => { type => SCALAR | ARRAYREF, optional => 1 },
    query    => { type => HASHREF, default  => {} },
    fragment => { type => SCALAR,  optional => 1 },
);

sub uri_object {
    my %p = validate( @_, \%BaseParams );
    _check_required( \%p );

    my $uri = URI->new();

    $uri->scheme( $p{scheme} )
        if grep { defined && length } $p{scheme};

    if ( grep { defined && length } $p{username}, $p{password} ) {
        $p{username} ||= q{};
        $p{password} ||= q{};
        if ( $uri->can('user') && $uri->can('password') ) {
            $uri->user( $p{username} );
            $uri->password( $p{password} );
        }
        else {
            $uri->userinfo("$p{username}:$p{password}");
        }
    }

    for my $k (qw( host port )) {
        $uri->$k( $p{$k} )
            if grep { defined && length } $p{$k};
    }

    if ( $p{path} ) {
        if ( ref $p{path} ) {
            $uri->path( join '/', grep {defined} @{ $p{path} } );
        }
        else {
            $uri->path( $p{path} );
        }
    }

    $uri->query_form( $p{query} );

    $uri->fragment( $p{fragment} )
        if grep { defined && length } $p{fragment};

    return $uri;
}

{
    my $spec = {
        %BaseParams,
        query_separator => { type => SCALAR, default => ';' },
    };

    sub uri {
        my %p = validate(
            @_,
            $spec,
        );
        _check_required( \%p );

        my $sep = delete $p{query_separator};
        my $uri = uri_object(%p);

        if ( $sep ne '&' && $uri->query() ) {
            my $query = $uri->query();
            $query =~ s/&/$sep/g;
            $uri->query($query);
        }

        # force stringification
        return $uri->canonical() . q{};
    }
}

sub _check_required {
    my $p = shift;

    return
        if (
        grep { defined and length }
        map { $p->{$_} } qw( host fragment )
        );

    return
        if ref $p->{path}
        ? @{ $p->{path} }
        : defined $p->{path} && length $p->{path};

    return if keys %{ $p->{query} };

    require Carp;
    local $Carp::CarpLevel = 1;
    Carp::croak( 'None of the required parameters '
            . '(host, path, fragment, or query) were given' );
}

1;

# ABSTRACT: Build a URI from a set of named parameters

__END__

=pod

=head1 NAME

URI::FromHash - Build a URI from a set of named parameters

=head1 VERSION

version 0.05

=head1 SYNOPSIS

  use URI::FromHash qw( uri );

  my $uri = uri(
      path  => '/some/path',
      query => { foo => 1, bar => 2 },
  );

=head1 DESCRIPTION

This module provides a simple one-subroutine "named parameters" style
interface for creating URIs. Underneath the hood it uses C<URI.pm>,
though because of the simplified interface it may not support all
possible options for all types of URIs.

It was created for the common case where you simply want to have a
simple interface for creating syntactically correct URIs from known
components (like a path and query string). Doing this using the native
C<URI.pm> interface is rather tedious, requiring a number of method
calls, which is particularly ugly when done inside a templating system
such as Mason or TT2.

=head1 FUNCTIONS

This module provides two functions both of which are I<optionally>
exportable:

=head2 uri( ... ) and uri_object( ... )

Both of these functions accept the same set of parameters, except for
one additional parameter allowed when calling C<uri()>.

The C<uri()> function simply returns a string representing a
canonicalized URI based on the provided parameters. The
C<uri_object()> function returns new a C<URI.pm> object based on the
given parameters.

These parameters are:

=over 4

=item * scheme

The URI's scheme. This is optional, and if none is given you will
create a schemeless URI. This is useful if you want to create a URI to
a path on the same server (as is commonly done in C<< <a> >> tags).

=item * host

=item * port

=item * path

The path can be either a string or an array reference.

If an array reference is passed each I<defined> member of the array
will be joined by a single forward slash (/).

If you are building a host-less URI and want to include a leading
slash then make the first element of the array reference an empty
string (C<q{}>).

You can add a trailing slash by making the last element of the array
reference an empty string.

=item * username

=item * password

=item * fragment

All of these are optional strings which can be used to specify that
part of the URI.

=item * query

This should be a hash reference of query parameters. The values for
each key may be a scalar or array reference. Use an array reference to
provide multiple values for one key.

=item * query_separator

This option is can I<only> be provided when calling C<uri()>. By
default, it is a semi-colon (;).

=back

=head1 BUGS

Please report any bugs or feature requests to
C<bug-uri-fromhash@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2015 by Dave Rolsky.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut