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