File Coverage

blib/lib/Catalyst/Plugin/Shorten.pm
Criterion Covered Total %
statement 76 76 100.0
branch 36 36 100.0
condition 7 8 87.5
subroutine 15 15 100.0
pod 8 8 100.0
total 142 143 99.3


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::Shorten;
2 7     7   93405 use 5.006; use strict; use warnings; our $VERSION = '0.04';
  7     7   28  
  7     7   42  
  7         14  
  7         154  
  7         36  
  7         15  
  7         383  
3              
4 7     7   3111 use Bijection qw/all/;
  7         31912  
  7         53  
5 7     7   1388 use Scalar::Util qw/reftype/;
  7         19  
  7         383  
6 7     7   44 use Carp;
  7         14  
  7         4405  
7              
8             our ($pkey, $ukey, $short);
9              
10             sub setup {
11 6     6 1 1905918 my $c = shift;
12              
13 6         50 my $config = $c->config->{'Plugin::Shorten'};
14              
15 6 100       731 if ($config->{set}) {
16 1         3 $c->shorten_bijection_set(@{$config->{set}});
  1         69  
17             }
18              
19 6 100       84 if ($config->{offset}) {
20 1         8 $c->shorten_offset_set($config->{offset});
21             }
22              
23 6   100     57 $pkey = $config->{map}->{params} || 'params';
24 6   100     36 $ukey = $config->{map}->{uri} || 'uri';
25 6   100     32 $short = $config->{map}->{s} || 's';
26              
27 6         44 1;
28             }
29              
30             sub shorten {
31 19     19 1 347790 my ($c, %args) = @_;
32              
33             my $id = $c->shorten_set_data(
34             ($args{uri}
35             ? (
36             $ukey => $args{uri},
37             $pkey => $args{uri}->query_form_hash
38             )
39             : (
40             $ukey => $c->req->uri,
41             $pkey => $c->req->params,
42             )
43             ),
44 19 100       171 ($args{store} ? %{$args{store}} : ())
  1 100       147  
45             );
46              
47 19         84 my $string = biject($id);
48             return $args{as_uri}
49             ? $args{uri}
50 19 100       964 ? do { $args{uri}->query_form($short => $string); $args{uri} }
  1 100       11  
  1         143  
51             : $c->uri_for_action($c->action->private_path, { $short => $string })
52             : $string;
53             }
54              
55             sub shorten_delete {
56 3     3 1 57952 my ($c, %args) = @_;
57              
58 3 100       12 if (!$args{$short}) {
59 2 100       6 unless ($args{$short} = $c->req->param($short)) {
60 1         108 Catalyst::Exception->throw(sprintf 'Unable to find %s to delete', $short);
61             }
62             }
63              
64 2         182 my $id = inverse($args{$short});
65 2         34 return $c->shorten_delete_data($id);
66             }
67              
68             sub shorten_extract {
69 10     10 1 215582 my ($c, %args) = @_;
70              
71 10 100       71 $args{params} = $c->req->params unless $args{params}; # 100% the conditionals, ||= would always be true :)
72 10         660 $args{allow_missing} = 1;
73 10 100       59 if (my $sparams = $c->shorten_params(%args)) {
74 8         24 delete $args{params}->{$short};
75 8 100       29 $sparams = {%{$sparams}, %{$args{params}}} unless $args{no_merge};
  5         23  
  5         30  
76 8         31 $c->req->parameters($sparams);
77             }
78              
79 9         681 1;
80             }
81 7     7   4502 use Data::Dumper;
  7         44539  
  7         2754  
82             sub shorten_params {
83 22     22 1 270185 my ($c, %args) = @_;
84 22 100 50     121 $args{params} = $c->req->params || {} unless $args{params};
85 22 100       909 if ($args{params}->{$short}) {
86 20         110 my $id = inverse($args{params}->{$short});
87 19         417 my $shorten = $c->shorten_get_data($id);
88 19 100       78 if (exists $args{cb}) {
89 4         17 $shorten = $args{cb}->($c, $shorten);
90             }
91 19 100       453 return $shorten->{$pkey} if $shorten; # reftype for blessed
92             Catalyst::Exception->throw(sprintf 'Unable to find params for: %s -> %s : %s',
93 5         153 $args{params}->{$short}, $id, $pkey);
94             }
95             Catalyst::Exception->throw(sprintf 'Unable to find short in params for: %s', $short)
96 2 100       22 unless ( $args{allow_missing} );
97 1         5 undef;
98             }
99              
100             sub shorten_redirect {
101 5     5 1 106155 my ($c, %args) = @_;
102 5         37 my $id = inverse($args{$short});
103 5         112 my $shorten = $c->shorten_get_data($id);
104 5 100       29 if (exists $args{cb}) {
105 2         11 $shorten = $args{cb}->($c, $shorten);
106             }
107 5 100       195 return $c->res->redirect($shorten->{$ukey}) if $shorten;
108 1         17 Catalyst::Exception->throw(sprintf 'Unable to find uri to redirect for: %s -> %s', $args{$short}, $id);
109             }
110              
111             sub shorten_bijection_set {
112 1     1 1 12 my ($c, @set) = @_;
113 1         6 bijection_set(@set);
114             }
115              
116             sub shorten_offset_set {
117 6     6 1 112676 my ($c, @set) = @_;
118 6         33 offset_set(@set);
119             }
120              
121             1;
122              
123             __END__
124              
125             =head1 NAME
126              
127             Catalyst::Plugin::Shorten - The great ancient URI shortner!
128              
129             =for html
130             <a href="https://travis-ci.org/ThisUsedToBeAnEmail/Catalyst-Plugin-Shorten"><img src="https://travis-ci.org/ThisUsedToBeAnEmail/Catalyst-Plugin-Shorten.svg?branch=master" alt="Build Status"></a>
131             <a href="https://coveralls.io/r/ThisUsedToBeAnEmail/Catalyst-Plugin-Shorten?branch=master"><img src="https://coveralls.io/repos/ThisUsedToBeAnEmail/Catalyst-Plugin-Shorten/badge.svg?branch=master" alt="Coverage Status"></a>
132             <a href="https://metacpan.org/pod/Catalyst-Plugin-Shorten"><img src="https://badge.fury.io/pl/Catalyst-Plugin-Shorten.svg" alt="CPAN version"></a>
133              
134             =head1 VERSION
135              
136             Version 0.04
137              
138             =cut
139              
140             =head1 SYNOPSIS
141              
142             use Catalyst qw/
143             Shorten
144             Shorten::Store::Dummy
145             /;
146              
147             sub auto :Path :Args(0) {
148             my ($self, $c) = @_;
149             $c->shorten_extract; # checks whether the shorten param exists if it does merges the stored params into the request
150             }
151              
152             ........
153              
154             sub endpoint :Chained('base') :PathPart('ending') :Args('0') {
155             my ($self, $c) = @_;
156              
157             my $str = $c->shorten(); # returns bijection references to an ID in the store.
158             my $url = $c->shorten(as_uri => 1); # return a url to the current endpoint replacing all params with localhost:300/ending?s=GH
159             }
160              
161             -------
162              
163             use Catalyst qw/
164             Shorten
165             Shorten::Store::Dummy
166             /;
167              
168             __PACKAGE__->config(
169             ......
170             'Plugin::Shorten' => {
171             set => [qw/c b a ..../],
172             map => {
173             params => 'data',
174             uri => 'url',
175             s => 'g'
176             }
177             }
178             );
179              
180             package TestApp::Controller::Shorten;
181              
182             use Moose;
183             use namespace::autoclean;
184              
185             BEGIN {
186             extends 'Catalyst::Controller';
187             }
188              
189             sub g :Chained('/') :PathPart('g') :Args('1') {
190             my ($self, $c, $cap) = @_;
191             $c->shorten_redirect(g => $cap);
192             }
193              
194             __PACKAGE__->meta->make_immutable;
195              
196             1;
197              
198             =head1 SUBROUTINES/METHODS
199              
200             =head2 shorten (as_uri => 1|0, uri => URI, store => {} )
201              
202             Take the current request uri and store, returns an Bijective string.
203              
204             =cut
205              
206             =head2 shorten_delete (s => '')
207              
208             Delete from storage.
209              
210             =cut
211              
212             =head2 shorten_extract (params => { s => ...}, cb => sub)
213              
214             Check for the param (default is 's'), if defined attempt to inverse and then right merge with the current requests params.
215              
216             This always returns true and you can later access the merged params using -
217              
218             $c->req->params;
219              
220             =cut
221              
222             =head2 shorten_params (params => { s => ...}, cb => sub)
223              
224             Check for the param (default is 's'), if defined attempt to inverse and then return the params retrieved from storage.
225              
226             =cut
227              
228             =head2 shorten_redirect (s => '', cb => sub)
229              
230             Redirect the clients browser to the uri retrieved from the storage.
231              
232             =cut
233              
234             =head2 shorten_bijection_set (@set)
235              
236             =cut
237              
238             =head2 shorten_offset_set ($offset)
239              
240             =cut
241              
242             =head2 setup
243              
244             =cut
245              
246             =head1 AUTHOR
247              
248             LNATION, C<< <thisusedtobeanemail at gmail.com> >>
249              
250             =head1 BUGS
251              
252             Please report any bugs or feature requests to C<bug-catalyst-plugin-shorten at rt.cpan.org>, or through
253             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Plugin-Shorten>. I will be notified, and then you'll
254             automatically be notified of progress on your bug as I make changes.
255              
256             =head1 SUPPORT
257              
258             You can find documentation for this module with the perldoc command.
259              
260             perldoc Catalyst::Plugin::Shorten
261              
262              
263             You can also look for information at:
264              
265             =over 4
266              
267             =item * RT: CPAN's request tracker (report bugs here)
268              
269             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Plugin-Shorten>
270              
271             =item * AnnoCPAN: Annotated CPAN documentation
272              
273             L<http://annocpan.org/dist/Catalyst-Plugin-Shorten>
274              
275             =item * CPAN Ratings
276              
277             L<http://cpanratings.perl.org/d/Catalyst-Plugin-Shorten>
278              
279             =item * Search CPAN
280              
281             L<http://search.cpan.org/dist/Catalyst-Plugin-Shorten/>
282              
283             =back
284              
285              
286             =head1 ACKNOWLEDGEMENTS
287              
288              
289             =head1 LICENSE AND COPYRIGHT
290              
291             Copyright 2018 LNATION.
292              
293             This program is free software; you can redistribute it and/or modify it
294             under the terms of the the Artistic License (2.0). You may obtain a
295             copy of the full license at:
296              
297             L<http://www.perlfoundation.org/artistic_license_2_0>
298              
299             Any use, modification, and distribution of the Standard or Modified
300             Versions is governed by this Artistic License. By using, modifying or
301             distributing the Package, you accept this license. Do not use, modify,
302             or distribute the Package, if you do not accept this license.
303              
304             If your Modified Version has been derived from a Modified Version made
305             by someone other than you, you are nevertheless required to ensure that
306             your Modified Version complies with the requirements of this license.
307              
308             This license does not grant you the right to use any trademark, service
309             mark, tradename, or logo of the Copyright Holder.
310              
311             This license includes the non-exclusive, worldwide, free-of-charge
312             patent license to make, have made, use, offer to sell, sell, import and
313             otherwise transfer the Package with respect to any patent claims
314             licensable by the Copyright Holder that are necessarily infringed by the
315             Package. If you institute patent litigation (including a cross-claim or
316             counterclaim) against any party alleging that the Package constitutes
317             direct or contributory patent infringement, then this Artistic License
318             to you shall terminate on the date that such litigation is filed.
319              
320             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
321             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
322             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
323             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
324             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
325             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
326             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
327             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
328              
329              
330             =cut
331              
332             1; # End of Catalyst::Plugin::Shorten