rt/lib/RT/Link.pm

   1 # $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Link.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $
   2 # (c) 1996-1999 Jesse Vincent <jesse@fsck.com>
   3 # This software is redistributable under the terms of the GNU GPL
   4
   5 =head1 NAME
   6
   7   RT::Link - an RT Link object
   8
   9 =head1 SYNOPSIS
  10
  11   use RT::Link;
  12
  13 =head1 DESCRIPTION
  14
  15 This module should never be called directly by client code. it's an internal module which
  16 should only be accessed through exported APIs in Ticket other similar objects.
  17
  18 =head1 METHODS
  19
  20
  21 =begin testing
  22
  23 ok (require RT::TestHarness);
  24 ok (require RT::Link);
  25
  26 =end testing
  27
  28 =cut
  29
  30 package RT::Link;
  31 use RT::Record;
  32 use Carp;
  33 @ISA= qw(RT::Record);
  34
  35 # {{{ sub _Init
  36 sub _Init  {
  37   my $self  = shift;
  38   $self->{'table'} = "Links";
  39   return ($self->SUPER::_Init(@_));
  40 }
  41
  42 # }}}
  43
  44 # {{{ sub Create
  45
  46 =head2 Create PARAMHASH
  47
  48 Create a new link object. Takes 'Base', 'Target' and 'Type'.
  49 Returns undef on failure or a Link Id on success.
  50
  51 =cut
  52
  53 sub Create  {
  54     my $self = shift;
  55     my %args = ( Base => undef,
  56                  Target => undef,
  57                  Type => undef,
  58                  @_ # get the real argumentlist
  59                );
  60
  61     my $BaseURI = $self->CanonicalizeURI($args{'Base'});
  62     my $TargetURI = $self->CanonicalizeURI($args{'Target'});
  63
  64     unless (defined $BaseURI) {
  65         $RT::Logger->warning ("$self couldn't resolve base:'".$args{'Base'}.
  66                               "' into a URI\n");
  67         return (undef);
  68     }
  69     unless (defined $TargetURI) {
  70         $RT::Logger->warning ("$self couldn't resolve target:'".$args{'Target'}.
  71                               "' into a URI\n");
  72         return(undef);
  73     }
  74
  75     my $LocalBase = $self->_IsLocal($BaseURI);
  76     my $LocalTarget = $self->_IsLocal($TargetURI);
  77     my $id = $self->SUPER::Create(Base => "$BaseURI",
  78                                   Target => "$TargetURI",
  79                                   LocalBase => $LocalBase,
  80                                   LocalTarget => $LocalTarget,
  81                                   Type => $args{'Type'});
  82     return ($id);
  83 }
  84
  85 # }}}
  86
  87 # {{{ sub Load
  88
  89 =head2 Load
  90
  91   Load an RT::Link object from the database.  Takes one parameter or three.
  92   One parameter is the id of an entry in the links table.  Three parameters are a tuple of (base, linktype, target);
  93
  94
  95 =cut
  96
  97 sub Load  {
  98   my $self = shift;
  99   my $identifier = shift;
 100   my $linktype = shift if (@_);
 101   my $target = shift if (@_);
 102
 103   if ($target) {
 104       my $BaseURI = $self->CanonicalizeURI($identifier);
 105       my $TargetURI = $self->CanonicalizeURI($target);
 106       $self->LoadByCols( Base => $BaseURI,
 107                          Type => $linktype,
 108                          Target => $TargetURI
 109                        ) || return (0, "Couldn't load link");
 110   }
 111
 112   elsif ($identifier =~ /^\d+$/) {
 113       $self->LoadById($identifier) ||
 114         return (0, "Couldn't load link");
 115   }
 116   else {
 117         return (0, "That's not a numerical id");
 118   }
 119 }
 120
 121 # }}}
 122
 123 # {{{ sub TargetObj
 124
 125 =head2 TargetObj
 126
 127 =cut
 128
 129 sub TargetObj {
 130   my $self = shift;
 131    return $self->_TicketObj('base',$self->Target);
 132 }
 133 # }}}
 134
 135 # {{{ sub BaseObj
 136
 137 =head2 BaseObj
 138
 139 =cut
 140
 141 sub BaseObj {
 142   my $self = shift;
 143   return $self->_TicketObj('target',$self->Base);
 144 }
 145 # }}}
 146
 147 # {{{ sub _TicketObj
 148 sub _TicketObj {
 149   my $self = shift;
 150   my $name = shift;
 151   my $ref = shift;
 152   my $tag="$name\_obj";
 153
 154   unless (exists $self->{$tag}) {
 155
 156   $self->{$tag}=RT::Ticket->new($self->CurrentUser);
 157
 158   #If we can get an actual ticket, load it up.
 159   if ($self->_IsLocal($ref)) {
 160       $self->{$tag}->Load($ref);
 161     }
 162   }
 163   return $self->{$tag};
 164 }
 165 # }}}
 166
 167 # {{{ sub _Accessible
 168 sub _Accessible  {
 169   my $self = shift;
 170   my %Cols = (
 171               LocalBase => 'read',
 172               LocalTarget => 'read',
 173               Base => 'read',
 174               Target => 'read',
 175               Type => 'read',
 176               Creator => 'read/auto',
 177               Created => 'read/auto',
 178               LastUpdatedBy => 'read/auto',
 179               LastUpdated => 'read/auto'
 180              );
 181   return($self->SUPER::_Accessible(@_, %Cols));
 182 }
 183 # }}}
 184
 185
 186 # Static methods:
 187
 188 # {{{ sub BaseIsLocal
 189
 190 =head2 BaseIsLocal
 191
 192 Returns true if the base of this link is a local ticket
 193
 194 =cut
 195
 196 sub BaseIsLocal {
 197   my $self = shift;
 198   return $self->_IsLocal($self->Base);
 199 }
 200
 201 # }}}
 202
 203 # {{{ sub TargetIsLocal
 204
 205 =head2 TargetIsLocal
 206
 207 Returns true if the target of this link is a local ticket
 208
 209 =cut
 210
 211 sub TargetIsLocal {
 212   my $self = shift;
 213   return $self->_IsLocal($self->Target);
 214 }
 215
 216 # }}}
 217
 218 # {{{ sub _IsLocal
 219
 220 =head2 _IsLocal URI
 221
 222 When handed a URI returns the local ticket id if it\'s local. otherwise returns undef.
 223
 224 =cut
 225
 226 sub _IsLocal {
 227     my $self = shift;
 228     my $URI=shift;
 229     unless ($URI) {
 230         $RT::Logger->warning ("$self _IsLocal called without a URI\n");
 231         return (undef);
 232     }
 233     # TODO: More thorough check
 234     if ($URI =~ /^$RT::TicketBaseURI(\d+)$/) {
 235         return($1);
 236     }
 237     else {
 238         return (undef);
 239     }
 240 }
 241 # }}}
 242
 243
 244 # {{{ sub BaseAsHREF
 245
 246 =head2 BaseAsHREF
 247
 248 Returns an HTTP url to access the base of this link
 249
 250 =cut
 251
 252 sub BaseAsHREF {
 253   my $self = shift;
 254   return $self->AsHREF($self->Base);
 255 }
 256 # }}}
 257
 258 # {{{ sub TargetAsHREF
 259
 260 =head2 TargetAsHREF
 261
 262 return an HTTP url to access the target of this link
 263
 264 =cut
 265
 266 sub TargetAsHREF {
 267   my $self = shift;
 268   return $self->AsHREF($self->Target);
 269 }
 270 # }}}
 271
 272 # {{{ sub AsHREF - Converts Link URIs to HTTP URLs
 273 =head2 URI
 274
 275 Takes a URI and returns an http: url to access that object.
 276
 277 =cut
 278 sub AsHREF {
 279     my $self=shift;
 280     my $URI=shift;
 281     if ($self->_IsLocal($URI)) {
 282         my $url=$RT::WebURL . "Ticket/Display.html?id=$URI";
 283         return($url);
 284     }
 285     else {
 286         my ($protocol) = $URI =~ m|(.*?)://|;
 287         unless (exists $RT::URI2HTTP{$protocol}) {
 288             $RT::Logger->warning("Linking for protocol $protocol not defined in the config file!");
 289             return("");
 290         }
 291         return $RT::URI2HTTP{$protocol}->($URI);
 292     }
 293 }
 294
 295 # }}}
 296
 297 # {{{ sub GetContent - gets the content from a link
 298 sub GetContent {
 299     my ($self, $URI)= @_;
 300     if ($self->_IsLocal($URI)) {
 301         die "stub";
 302     } else {
 303         # Find protocol
 304         if ($URI =~ m|^(.*?)://|) {
 305             if (exists $RT::ContentFromURI{$1}) {
 306                 return $RT::ContentFromURI{$1}->($URI);
 307             } else {
 308                 warn "No sub exists for fetching the content from a $1 in $URI";
 309             }
 310         } else {
 311             warn "No protocol specified in $URI";
 312         }
 313     }
 314 }
 315 # }}}
 316
 317 # {{{ sub CanonicalizeURI
 318
 319 =head2 CanonicalizeURI
 320
 321 Takes a single argument: some form of ticket identifier.
 322 Returns its canonicalized URI.
 323
 324 Bug: ticket aliases can't have :// in them. URIs must have :// in them.
 325
 326 =cut
 327
 328 sub CanonicalizeURI {
 329     my $self = shift;
 330     my $id = shift;
 331
 332
 333     #If it's a local URI, load the ticket object and return its URI
 334     if ($id =~ /^$RT::TicketBaseURI/) {
 335         my $ticket = new RT::Ticket($self->CurrentUser);
 336         $ticket->Load($id);
 337         #If we couldn't find a ticket, return undef.
 338         return undef unless (defined $ticket->Id);
 339         #$RT::Logger->debug("$self -> CanonicalizeURI was passed $id and returned ".$ticket->URI ." (uri)\n");
 340         return ($ticket->URI);
 341     }
 342     #If it's a remote URI, we're going to punt for now
 343     elsif ($id =~ '://' ) {
 344         return ($id);
 345     }
 346
 347     #If the base is an integer, load it as a ticket
 348     elsif ( $id =~ /^\d+$/ ) {
 349
 350         #$RT::Logger->debug("$self -> CanonicalizeURI was passed $id. It's a ticket id.\n");
 351         my $ticket = new RT::Ticket($self->CurrentUser);
 352         $ticket->Load($id);
 353         #If we couldn't find a ticket, return undef.
 354         return undef unless (defined $ticket->Id);
 355         #$RT::Logger->debug("$self returned ".$ticket->URI ." (id #)\n");
 356         return ($ticket->URI);
 357     }
 358
 359     #It's not a URI. It's not a numerical ticket ID
 360     else {
 361
 362         #If we couldn't find a ticket, return undef.
 363         return( undef);
 364
 365     }
 366
 367
 368 }
 369
 370 # }}}
 371
 372 1;
 373