Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / URI.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
6 #                                          <sales@bestpractical.com>
7 #
8 # (Except where explicitly superseded by other copyright notices)
9 #
10 #
11 # LICENSE:
12 #
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
16 # from www.gnu.org.
17 #
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28 #
29 #
30 # CONTRIBUTION SUBMISSION POLICY:
31 #
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
37 #
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
46 #
47 # END BPS TAGGED BLOCK }}}
48
49 package RT::URI;
50
51 use strict;
52 use warnings;
53 use base 'RT::Base';
54
55 use RT::URI::base;
56 use Carp;
57
58 =head1 NAME
59
60 RT::URI
61
62 =head1 DESCRIPTION
63
64 This class provides a base class for URIs, such as those handled
65 by RT::Link objects.  
66
67 =head1 API
68
69
70
71 =cut
72
73
74
75
76 =head2 new
77
78 Create a new RT::URI object.
79
80 =cut
81
82                          
83 sub new {
84     my $proto = shift;
85     my $class = ref($proto) || $proto;
86     my $self  = {};
87     bless( $self, $class );
88
89     $self->CurrentUser(@_);
90
91     return ($self);
92 }
93
94 =head2 CanonicalizeURI <URI>
95
96 Returns the canonical form of the given URI by calling L</FromURI> and then L</URI>.
97
98 If the URI is unparseable by FromURI the passed in URI is simply returned untouched.
99
100 =cut
101
102 sub CanonicalizeURI {
103     my $self = shift;
104     my $uri  = shift;
105     if ($self->FromURI($uri)) {
106         my $canonical = $self->URI;
107         if ($canonical and $uri ne $canonical) {
108             RT->Logger->debug("Canonicalizing URI '$uri' to '$canonical'");
109             $uri = $canonical;
110         }
111     }
112     return $uri;
113 }
114
115
116 =head2 FromObject <Object>
117
118 Given a local object, such as an RT::Ticket or an RT::Article, this routine will return a URI for
119 the local object
120
121 =cut
122
123 sub FromObject {
124     my $self = shift;
125     my $obj = shift;
126
127     return undef unless  $obj->can('URI');
128     return $self->FromURI($obj->URI);
129 }
130
131
132
133 =head2 FromURI <URI>
134
135 Returns a local object id for this content. You are expected to know
136 what sort of object this is the Id of
137
138 Returns true if everything is ok, otherwise false
139
140 =cut
141
142 sub FromURI {
143     my $self = shift;
144     my $uri = shift;
145
146     return undef unless ($uri);
147
148     my $scheme;
149     # Special case: integers passed in as URIs must be ticket ids
150     if ($uri =~ /^(\d+)$/) {
151         $scheme = "fsck.com-rt";
152     } elsif ($uri =~ /^((?!javascript|data)(?:\w|\.|-)+?):/i) {
153         $scheme = $1;
154     }
155     else {
156         $self->{resolver} = RT::URI::base->new( $self->CurrentUser ); # clear resolver
157         $RT::Logger->warning("Could not determine a URI scheme for $uri");
158         return (undef);
159     }
160
161     # load up a resolver object for this scheme
162     $self->_GetResolver($scheme);
163
164     unless ($self->Resolver->ParseURI($uri)) {
165         $RT::Logger->warning( "Resolver "
166               . ref( $self->Resolver )
167               . " could not parse $uri, maybe Organization config was changed?"
168         );
169         $self->{resolver} = RT::URI::base->new( $self->CurrentUser ); # clear resolver
170         return (undef);
171     }
172
173     return(1);
174
175 }
176
177
178
179 =head2 _GetResolver <scheme>
180
181 Gets an RT URI resolver for the scheme <scheme>. 
182 Falls back to a null resolver. RT::URI::base.
183
184 =cut
185
186 sub _GetResolver {
187     my $self = shift;
188     my $scheme = shift;
189
190     $scheme =~ s/(\.|-)/_/g;
191     my $resolver;
192
193     
194     eval " 
195         require RT::URI::$scheme;
196         \$resolver = RT::URI::$scheme->new(\$self->CurrentUser);
197     ";
198      
199     if ($resolver) {
200         $self->{'resolver'} = $resolver;
201     } else {
202         RT->Logger->warning("Failed to create new resolver object for scheme '$scheme': $@")
203             if $@ !~ m{Can't locate RT/URI/\Q$scheme\E};
204         $self->{'resolver'} = RT::URI::base->new($self->CurrentUser); 
205     }
206
207 }
208
209
210
211 =head2 Scheme
212
213 Returns a local object id for this content.  You are expected to know
214 what sort of object this is the Id of
215
216 =cut
217
218 sub Scheme {
219     my $self = shift;
220     return ($self->Resolver->Scheme);
221
222 }
223
224 =head2 URI
225
226 Returns a local object id for this content.  You are expected to know what sort of object this is the Id 
227 of 
228
229 =cut
230
231 sub URI {
232     my $self = shift;
233     return ($self->Resolver->URI);
234
235 }
236
237
238 =head2 Object
239
240 Returns a local object for this content. This will usually be an RT::Ticket or somesuch
241
242 =cut
243
244
245 sub Object {   
246     my $self = shift;
247     return($self->Resolver->Object);
248
249 }
250
251
252
253
254 =head2 IsLocal
255
256 Returns a local object for this content. This will usually be an RT::Ticket or somesuch
257
258 =cut
259
260 sub IsLocal {
261     my $self = shift;
262     return $self->Resolver->IsLocal;     
263 }
264
265
266
267 =head2 AsHREF
268
269
270 =cut
271
272
273 sub AsHREF {
274     my $self = shift;
275     return $self->Resolver->HREF;
276 }
277
278 =head2 Resolver
279
280 Returns this URI's URI resolver object
281
282 =cut
283
284
285 sub Resolver {
286     my $self =shift;
287     return ($self->{'resolver'});
288 }
289
290 =head2 AsString
291
292 Returns a friendly display form of the object if Local, or the full URI
293
294 =cut
295
296 sub AsString {
297     my $self = shift;
298     return $self->Resolver->AsString;
299 }
300
301 RT::Base->_ImportOverlays();
302
303 1;