root/lang/perl/URI-Platonic/trunk/lib/URI/Platonic.pm @ 24364

Revision 24364, 3.0 kB (checked in by masaki, 6 years ago)

Moose ベースで書き直した

Line 
1package URI::Platonic;
2
3use Moose;
4use MooseX::Types::URI qw(Uri);
5use overload '""' => \&as_string, fallback => 1;
6
7has 'uri' => (
8    is       => 'ro',
9    isa      => Uri,
10    coerce   => 1,
11    required => 1,
12);
13
14# no Moose handles ?
15{
16    my @handles = qw(
17        authority opaque userinfo host_port
18        scheme host port path query fragment
19        path_query path_segments
20        query_form query_keywords
21    );
22
23    for my $method (@handles) {
24        __PACKAGE__->meta->add_method($method, sub {
25            my $self = shift;
26            $self->uri->$method(@_);
27        });
28    }
29}
30
31has 'extension' => (
32    is  => 'rw',
33    isa => 'Str',
34);
35
36no Moose;
37
38our $VERSION = '0.01';
39
40sub BUILD {
41    my $self = shift;
42
43    my $path = $self->uri->path;
44    if ($path =~ m![^/]+\.([^/\.]+)$!) {
45        $self->extension($1);
46        $path =~ s/\.$1$//;
47        $self->uri->path($path);
48    }
49}
50
51sub clone {
52    my $self = shift;
53    my $class = ref $self || $self;
54    return $class->new(uri => $self->distinct->clone);
55}
56
57sub canonical {
58    my $self = shift;
59    my $class = ref $self || $self;
60    return $class->new(uri => $self->distinct->canonical);
61}
62
63sub platonic {
64    my $self = shift;
65    return $self->uri->clone;
66}
67
68sub distinct {
69    my $self = shift;
70
71    my $uri = $self->uri->clone;
72    if ($self->extension) {
73        $uri->path(join '.', $uri->path, $self->extension);
74    }
75
76    return $uri;
77}
78
791;
80
81__PACKAGE__->meta->make_immutable;
82
83=head1 NAME
84
85URI::Platonic - Platonic and Distinct URIs
86
87=head1 SYNOPSIS
88
89  use URI::Platonic;
90 
91  my $uri = URI::Platonic->new(uri => "http://example.com/path/to/resource.html");
92     $uri = URI::Platonic->new(uri => $uri);
93 
94  print $platonic->path;      # "/path/to/resource"
95  print $platonic->extension; # "html"
96  print $platonic->platonic;  # "http://example.com/path/to/resource"
97  print $platonic->distinct;  # "http://example.com/path/to/resource.html"
98 
99  $platonic->extension('xml');
100  print $platonic->distinct;  # "http://example.com/path/to/resource.xml"
101 
102  $platonic->path('/path/to/another');
103  print $platonic->platonic;  # "http://example.com/path/to/another"
104  print $platonic->distinct;  # "http://example.com/path/to/another.xml"
105
106=head1 DESCRIPTION
107
108URI::Platonic is a L<URI>-like module for "Platonic" and "Distinct" URIs,
109described in RESTful Web Services.
110
111=head1 METHODS
112
113=head2 new(uri => $uri)
114
115Constructs a new L<URI::Platonic> object.
116
117=head2 extension([ $extension ])
118
119Gets/Sets a extension part of the distinct URI.
120
121=head2 platonic()
122
123Returns a platonic L<URI>.
124
125=head2 distinct()
126
127Returns a distinct L<URI>.
128
129=head2 clone()
130
131Returns a copy of the L<URI::Platonic> object.
132
133=head2 canonical()
134
135Returns a normalized version of the L<URI::Platonic> object.
136
137=head2 as_string()
138
139Returns a plain string of the platonic URI.
140
141=head1 PRIVATES
142
143=head2 BUILD
144
145=head1 AUTHOR
146
147NAKAGAWA Masaki E<lt>masaki@cpan.orgE<gt>
148
149=head1 LICENSE
150
151This library is free software; you can redistribute it and/or modify
152it under the same terms as Perl itself.
153
154=head1 SEE ALSO
155
156L<URI>
157
158=cut
Note: See TracBrowser for help on using the browser.