rt/lib/RT/URI.pm

   1 # BEGIN LICENSE BLOCK
   2 #
   3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 #
   5 # (Except where explictly superceded by other copyright notices)
   6 #
   7 # This work is made available to you under the terms of Version 2 of
   8 # the GNU General Public License. A copy of that license should have
   9 # been provided with this software, but in any event can be snarfed
  10 # from www.gnu.org.
  11 #
  12 # This work is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # Unless otherwise specified, all modifications, corrections or
  18 # extensions to this work which alter its source code become the
  19 # property of Best Practical Solutions, LLC when submitted for
  20 # inclusion in the work.
  21 #
  22 #
  23 # END LICENSE BLOCK
  24 package RT::URI;;
  25
  26 use strict;
  27 use vars qw/@ISA/;
  28 @ISA = qw(RT::Base);
  29
  30 use RT::URI::base;
  31 use Carp;
  32
  33 =head1 NAME
  34
  35 RT::URI
  36
  37 =head1 DESCRIPTION
  38
  39 This class provides a base class for URIs, such as those handled
  40 by RT::Link objects.
  41
  42 =head1 API
  43
  44
  45
  46 =cut
  47
  48
  49
  50
  51 =head2 new
  52
  53 Create a new RT::URI object.
  54
  55 =cut
  56
  57
  58 sub new {
  59     my $proto = shift;
  60     my $class = ref($proto) || $proto;
  61     my $self  = {};
  62     bless( $self, $class );
  63
  64     $self->CurrentUser(@_);
  65
  66     return ($self);
  67 }
  68
  69
  70
  71 # {{{ FromObject
  72
  73 =head2 FromObject <Object>
  74
  75 Given a local object, such as an RT::Ticket or an RT::FM::Article, this routine will return a URI for
  76 the local object
  77
  78 =cut
  79
  80 sub FromObject {
  81     my $self = shift;
  82     my $obj = shift;
  83
  84     return undef unless  $obj->can('URI');
  85     return $self->FromURI($obj->URI);
  86 }
  87
  88 # }}}
  89
  90 # {{{ FromURI
  91
  92 =head2 FromURI <URI>
  93
  94 Returns a local object id for this content. You are expected to know
  95 what sort of object this is the Id of
  96
  97 Returns true if everything is ok, otherwise false
  98
  99 =cut
 100
 101 sub FromURI {
 102     my $self = shift;
 103     my $uri = shift;
 104
 105     return undef unless ($uri);
 106
 107         my $scheme;
 108         # Special case: integers passed in as URIs must be ticket ids
 109         if ($uri =~ /^(\d+)$/) {
 110                 $scheme = "fsck.com-rt";
 111         } elsif ($uri =~ /^((?:\w|\.|-)+?):/) {
 112          $scheme = $1;
 113     }
 114     else {
 115         $RT::Logger->warning("$self Could not determine a URI scheme for $uri");
 116                 return (undef);
 117     }
 118
 119     # load up a resolver object for this scheme
 120     $self->_GetResolver($scheme);
 121
 122     unless ($self->Resolver->ParseURI($uri)) {
 123         $RT::Logger->warning("Resolver ".ref($self->Resolver)." could not parse $uri");
 124         $self->{resolver} = undef; # clear resolver
 125         return (undef);
 126     }
 127
 128 return(1);
 129
 130 }
 131
 132 # }}}
 133
 134 # {{{ _GetResolver
 135
 136 =private _GetResolver <scheme>
 137
 138 Gets an RT URI resolver for the scheme <scheme>.
 139 Falls back to a null resolver. RT::URI::base.
 140
 141 =cut
 142
 143 sub _GetResolver {
 144     my $self = shift;
 145     my $scheme = shift;
 146
 147     $scheme =~ s/(\.|-)/_/g;
 148     my $resolver;
 149
 150
 151        eval "
 152             require RT::URI::$scheme;
 153             \$resolver = RT::URI::$scheme->new(\$self->CurrentUser);
 154        ";
 155
 156         if ($resolver) {
 157         $self->{'resolver'} = $resolver;
 158         } else {
 159         $self->{'resolver'} = RT::URI::base->new($self->CurrentUser);
 160         }
 161
 162 }
 163
 164 # }}}
 165
 166 # {{{ Scheme
 167
 168 =head2 Scheme
 169
 170 Returns a local object id for this content.  You are expected to know what sort of object this is the Id
 171 of
 172
 173 =cut
 174
 175 sub Scheme {
 176     my $self = shift;
 177     return ($self->Resolver->Scheme);
 178
 179 }
 180 # }}}
 181 # {{{ URI
 182
 183 =head2 URI
 184
 185 Returns a local object id for this content.  You are expected to know what sort of object this is the Id
 186 of
 187
 188 =cut
 189
 190 sub URI {
 191     my $self = shift;
 192     return ($self->Resolver->URI);
 193
 194 }
 195 # }}}
 196
 197 # {{{ Object
 198
 199 =head2 Object
 200
 201 Returns a local object for this content. This will usually be an RT::Ticket or somesuch
 202
 203 =cut
 204
 205
 206 sub Object {
 207     my $self = shift;
 208     return($self->Resolver->Object);
 209
 210 }
 211
 212
 213 # }}}
 214
 215 # {{{ IsLocal
 216
 217 =head2 IsLocal
 218
 219 Returns a local object for this content. This will usually be an RT::Ticket or somesuch
 220
 221 =cut
 222
 223 sub IsLocal {
 224     my $self = shift;
 225     return $self->Resolver->IsLocal;
 226 }
 227
 228
 229 # }}}
 230
 231
 232 =head Resolver
 233
 234 Returns this URI's URI resolver object
 235
 236 =cut
 237
 238
 239 sub Resolver {
 240     my $self =shift;
 241     return ($self->{'resolver'});
 242 }
 243
 244 eval "require RT::URI_Vendor";
 245 die $@ if ($@ && $@ !~ qr{^Can't locate RT/URI_Vendor.pm});
 246 eval "require RT::URI_Local";
 247 die $@ if ($@ && $@ !~ qr{^Can't locate RT/URI_Local.pm});
 248
 249 1;