rt/lib/RT/Link_Overlay.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 =head1 NAME
  25
  26   RT::Link - an RT Link object
  27
  28 =head1 SYNOPSIS
  29
  30   use RT::Link;
  31
  32 =head1 DESCRIPTION
  33
  34 This module should never be called directly by client code. it's an internal module which
  35 should only be accessed through exported APIs in Ticket other similar objects.
  36
  37 =head1 METHODS
  38
  39
  40 =begin testing
  41
  42
  43 use RT::Link;
  44 my $link = RT::Link->new($RT::SystemUser);
  45
  46
  47 ok (ref $link);
  48 ok (UNIVERSAL::isa($link, 'RT::Link'));
  49 ok (UNIVERSAL::isa($link, 'RT::Base'));
  50 ok (UNIVERSAL::isa($link, 'RT::Record'));
  51 ok (UNIVERSAL::isa($link, 'DBIx::SearchBuilder::Record'));
  52
  53 =end testing
  54
  55 =cut
  56
  57 use strict;
  58 no warnings qw(redefine);
  59
  60
  61 use Carp;
  62 use RT::URI;
  63
  64
  65 # {{{ sub Create
  66
  67 =head2 Create PARAMHASH
  68
  69 Create a new link object. Takes 'Base', 'Target' and 'Type'.
  70 Returns undef on failure or a Link Id on success.
  71
  72 =cut
  73
  74 sub Create {
  75     my $self = shift;
  76     my %args = ( Base   => undef,
  77                  Target => undef,
  78                  Type   => undef,
  79                  @_ );
  80
  81     my $base = RT::URI->new( $self->CurrentUser );
  82     $base->FromURI( $args{'Base'} );
  83
  84     unless ( $base->Scheme ) {
  85         $RT::Logger->warning( "$self couldn't resolve base:'"
  86                               . $args{'Base'} . " - "
  87                               . $base->Scheme
  88                               . "' into a URI\n" );
  89
  90         #use Data::Dumper;
  91         #$RT::Logger->warning(scalar Dumper $base);
  92         return (undef);
  93     }
  94
  95     my $target = RT::URI->new( $self->CurrentUser );
  96     $target->FromURI( $args{'Target'} );
  97
  98     unless ( $target->Resolver ) {
  99         $RT::Logger->warning( "$self couldn't resolve target:'"
 100                               . $args{'Target'} . " - "
 101                               . "' into a URI\n" );
 102
 103         #use Data::Dumper;
 104         #$RT::Logger->warning(scalar Dumper $target);
 105         return (undef);
 106     }
 107
 108     my $base_id   = 0;
 109     my $target_id = 0;
 110
 111
 112
 113
 114     if ( $base->IsLocal ) {
 115         unless (UNIVERSAL::can($base->Object, 'Id')) {
 116             return (undef, $self->loc("[_1] appears to be a local object, but can't be found in the database", $args{'Base'}));
 117
 118         }
 119         $base_id = $base->Object->Id;
 120     }
 121     if ( $target->IsLocal ) {
 122         unless (UNIVERSAL::can($target->Object, 'Id')) {
 123             return (undef, $self->loc("[_1] appears to be a local object, but can't be found in the database", $args{'Target'}));
 124
 125         }
 126         $target_id = $target->Object->Id;
 127     }
 128
 129     # {{{ We don't want references to ourself
 130     if ( $base->URI eq $target->URI ) {
 131         return ( 0, $self->loc("Can't link a ticket to itself") );
 132     }
 133
 134     # }}}
 135
 136     my ( $id, $msg ) = $self->SUPER::Create( Base        => $base->URI,
 137                                              Target      => $target->URI,
 138                                              LocalBase   => $base_id,
 139                                              LocalTarget => $target_id,
 140                                              Type        => $args{'Type'} );
 141     return ( $id, $msg );
 142 }
 143
 144 # }}}
 145  # {{{ sub LoadByParams
 146
 147 =head2 LoadByParams
 148
 149   Load an RT::Link object from the database.  Takes three parameters
 150
 151   Base => undef,
 152   Target => undef,
 153   Type =>undef
 154
 155   Base and Target are expected to be integers which refer to Tickets or URIs
 156   Type is the link type
 157
 158 =cut
 159
 160 sub LoadByParams {
 161     my $self = shift;
 162     my %args = ( Base   => undef,
 163                  Target => undef,
 164                  Type   => undef,
 165                  @_ );
 166
 167     my $base = RT::URI->new($self->CurrentUser);
 168     $base->FromURI( $args{'Base'} );
 169
 170     my $target = RT::URI->new($self->CurrentUser);
 171     $target->FromURI( $args{'Target'} );
 172
 173     unless ($base->Resolver && $target->Resolver) {
 174         return ( 0, $self->loc("Couldn't load link") );
 175     }
 176
 177
 178     my ( $id, $msg ) = $self->LoadByCols( Base   => $base->URI,
 179                                           Type   => $args{'Type'},
 180                                           Target => $target->URI );
 181
 182     unless ($id) {
 183         return ( 0, $self->loc("Couldn't load link") );
 184     }
 185 }
 186
 187 # }}}
 188 # {{{ sub Load
 189
 190 =head2 Load
 191
 192   Load an RT::Link object from the database.  Takes one parameter, the id of an entry in the links table.
 193
 194
 195 =cut
 196
 197 sub Load {
 198     my $self       = shift;
 199     my $identifier = shift;
 200
 201
 202
 203
 204     if ( $identifier !~ /^\d+$/ ) {
 205         return ( 0, $self->loc("That's not a numerical id") );
 206     }
 207     else {
 208         my ( $id, $msg ) = $self->LoadById($identifier);
 209         unless ( $self->Id ) {
 210             return ( 0, $self->loc("Couldn't load link") );
 211         }
 212         return ( $id, $msg );
 213     }
 214 }
 215
 216 # }}}
 217
 218
 219 # {{{ TargetURI
 220
 221 =head2 TargetURI
 222
 223 returns an RT::URI object for the "Target" of this link.
 224
 225 =cut
 226
 227 sub TargetURI {
 228     my $self = shift;
 229     my $URI = RT::URI->new($self->CurrentUser);
 230     $URI->FromURI($self->Target);
 231     return ($URI);
 232 }
 233
 234 # }}}
 235 # {{{ sub TargetObj
 236
 237 =head2 TargetObj
 238
 239 =cut
 240
 241 sub TargetObj {
 242   my $self = shift;
 243    return $self->TargetURI->Object;
 244 }
 245 # }}}
 246
 247 # {{{ BaseURI
 248
 249 =head2 BaseURI
 250
 251 returns an RT::URI object for the "Base" of this link.
 252
 253 =cut
 254
 255 sub BaseURI {
 256     my $self = shift;
 257     my $URI = RT::URI->new($self->CurrentUser);
 258     $URI->FromURI($self->Base);
 259     return ($URI);
 260 }
 261
 262 # }}}
 263 # {{{ sub BaseObj
 264
 265 =head2 BaseObj
 266
 267 =cut
 268
 269 sub BaseObj {
 270   my $self = shift;
 271   return $self->BaseURI->Object;
 272 }
 273 # }}}
 274
 275
 276
 277 # Static methods:
 278
 279 # {{{ sub BaseIsLocal
 280
 281 =head2 BaseIsLocal
 282
 283 Returns true if the base of this link is a local ticket
 284
 285 =cut
 286
 287 sub BaseIsLocal {
 288   my $self = shift;
 289   $RT::Logger->crit("Link::BaseIsLocal is deprecated in favor of Link->BaseURI->IsLocal");
 290   return $self->BaseURI->IsLocal;
 291 }
 292
 293 # }}}
 294
 295 # {{{ sub TargetIsLocal
 296
 297 =head2 TargetIsLocal
 298
 299 Returns true if the target of this link is a local ticket
 300
 301 =cut
 302
 303 sub TargetIsLocal {
 304   my $self = shift;
 305   $RT::Logger->crit("Link::BaseIsLocal is deprecated in favor of Link->BaseURI->IsLocal");
 306   return $self->TargetURI->IsLocal;
 307 }
 308
 309 # }}}
 310
 311
 312 # {{{ sub BaseAsHREF
 313
 314 =head2 BaseAsHREF
 315
 316 Returns an HTTP url to access the base of this link
 317
 318 =cut
 319
 320 sub BaseAsHREF {
 321   my $self = shift;
 322   $RT::Logger->crit("Link::BaseAsHREF deprecated in favor of ->BaseURI->AsHREF");
 323   return $self->BaseURI->HREF;
 324 }
 325 # }}}
 326
 327 # {{{ sub TargetAsHREF
 328
 329 =head2 TargetAsHREF
 330
 331 return an HTTP url to access the target of this link
 332
 333 =cut
 334
 335 sub TargetAsHREF {
 336   my $self = shift;
 337   $RT::Logger->crit("Link::TargetAsHREF deprecated in favor of ->TargetURI->AsHREF");
 338   return $self->TargetURI->HREF;
 339 }
 340 # }}}
 341
 342 # {{{ sub AsHREF - Converts Link URIs to HTTP URLs
 343
 344 =head2 URI
 345
 346 Takes a URI and returns an http: url to access that object.
 347
 348 =cut
 349
 350
 351 sub AsHREF {
 352     my $self=shift;
 353
 354     $RT::Logger->crit("AsHREF is gone. look at URI::HREF to figure out what to do with \$URI");
 355 }
 356
 357 # }}}
 358
 359 1;
 360