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 what sort of object this is the Id
  95 of
  96
  97 =cut
  98
  99 sub FromURI {
 100     my $self = shift;
 101     my $uri = shift;
 102
 103     return undef unless ($uri);
 104
 105         my $scheme;
 106         # Special case: integers passed in as URIs must be ticket ids
 107         if ($uri =~ /^(\d+)$/) {
 108                 $scheme = "fsck.com-rt";
 109         } elsif ($uri =~ /^((?:\w|\.|-)+?):/) {
 110          $scheme = $1;
 111     }
 112     else {
 113         $RT::Logger->warning("$self Could not determine a URI scheme for $uri");
 114                 return (undef);
 115     }
 116
 117     # load up a resolver object for this scheme
 118     $self->_GetResolver($scheme);
 119
 120     unless ($self->Resolver->ParseURI($uri)) {
 121         $RT::Logger->warning("Resolver ".ref($self->Resolver)." could not parse $uri");
 122         return (undef);
 123     }
 124
 125 }
 126
 127 # }}}
 128
 129 # {{{ _GetResolver
 130
 131 =private _GetResolver <scheme>
 132
 133 Gets an RT URI resolver for the scheme <scheme>.
 134 Falls back to a null resolver. RT::URI::base.
 135
 136 =cut
 137
 138 sub _GetResolver {
 139     my $self = shift;
 140     my $scheme = shift;
 141
 142     $scheme =~ s/(\.|-)/_/g;
 143     my $resolver;
 144
 145
 146        eval "
 147             require RT::URI::$scheme;
 148             \$resolver = RT::URI::$scheme->new(\$self->CurrentUser);
 149        ";
 150
 151         if ($resolver) {
 152         $self->{'resolver'} = $resolver;
 153         } else {
 154         $self->{'resolver'} = RT::URI::base->new($self->CurrentUser);
 155         }
 156
 157 }
 158
 159 # }}}
 160
 161 # {{{ Scheme
 162
 163 =head2 Scheme
 164
 165 Returns a local object id for this content.  You are expected to know what sort of object this is the Id
 166 of
 167
 168 =cut
 169
 170 sub Scheme {
 171     my $self = shift;
 172     return ($self->Resolver->Scheme);
 173
 174 }
 175 # }}}
 176 # {{{ URI
 177
 178 =head2 URI
 179
 180 Returns a local object id for this content.  You are expected to know what sort of object this is the Id
 181 of
 182
 183 =cut
 184
 185 sub URI {
 186     my $self = shift;
 187     return ($self->Resolver->URI);
 188
 189 }
 190 # }}}
 191
 192 # {{{ Object
 193
 194 =head2 Object
 195
 196 Returns a local object for this content. This will usually be an RT::Ticket or somesuch
 197
 198 =cut
 199
 200
 201 sub Object {
 202     my $self = shift;
 203     return($self->Resolver->Object);
 204
 205 }
 206
 207
 208 # }}}
 209
 210 # {{{ IsLocal
 211
 212 =head2 IsLocal
 213
 214 Returns a local object for this content. This will usually be an RT::Ticket or somesuch
 215
 216 =cut
 217
 218 sub IsLocal {
 219     my $self = shift;
 220     return $self->Resolver->IsLocal;
 221 }
 222
 223
 224 # }}}
 225
 226
 227 =head Resolver
 228
 229 Returns this URI's URI resolver object
 230
 231 =cut
 232
 233
 234 sub Resolver {
 235     my $self =shift;
 236     return ($self->{'resolver'});
 237 }
 238
 239 eval "require RT::URI_Vendor";
 240 die $@ if ($@ && $@ !~ qr{^Can't locate RT/URI_Vendor.pm});
 241 eval "require RT::URI_Local";
 242 die $@ if ($@ && $@ !~ qr{^Can't locate RT/URI_Local.pm});
 243
 244 1;