rt 4.0.23
[freeside.git] / rt / lib / RT / Link.pm
index 885ffe3..bd8ad61 100644 (file)
@@ -1,6 +1,50 @@
-# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Link.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $
-# (c) 1996-1999 Jesse Vincent <jesse@fsck.com>
-# This software is redistributable under the terms of the GNU GPL
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
 
 =head1 NAME
 
@@ -18,30 +62,24 @@ should only be accessed through exported APIs in Ticket other similar objects.
 =head1 METHODS
 
 
-=begin testing
-
-ok (require RT::TestHarness);
-ok (require RT::Link);
-
-=end testing
 
 =cut
 
+
 package RT::Link;
-use RT::Record;
-use Carp;
-@ISA= qw(RT::Record);
 
-# {{{ sub _Init
-sub _Init  {
-  my $self  = shift;
-  $self->{'table'} = "Links";
-  return ($self->SUPER::_Init(@_));
-}
+use strict;
+use warnings;
+
+
+
+use base 'RT::Record';
+
+sub Table {'Links'}
+use Carp;
+use RT::URI;
 
-# }}}
 
-# {{{ sub Create 
 
 =head2 Create PARAMHASH
 
@@ -50,89 +88,173 @@ Returns undef on failure or a Link Id on success.
 
 =cut
 
-sub Create  {
+sub Create {
     my $self = shift;
-    my %args = ( Base => undef,
-                Target => undef,
-                Type => undef,
-                @_ # get the real argumentlist
-              );
-    
-    my $BaseURI = $self->CanonicalizeURI($args{'Base'});
-    my $TargetURI = $self->CanonicalizeURI($args{'Target'});
-    
-    unless (defined $BaseURI) {
-       $RT::Logger->warning ("$self couldn't resolve base:'".$args{'Base'}.
-                             "' into a URI\n");
-       return (undef);
+    my %args = ( Base   => undef,
+                 Target => undef,
+                 Type   => undef,
+                 @_ );
+
+    my $base = RT::URI->new( $self->CurrentUser );
+    unless ($base->FromURI( $args{'Base'} )) {
+        my $msg = $self->loc("Couldn't resolve base '[_1]' into a URI.", $args{'Base'});
+        $RT::Logger->warning( "$self $msg" );
+        return wantarray ? (undef, $msg) : undef;
+    }
+
+    my $target = RT::URI->new( $self->CurrentUser );
+    unless ($target->FromURI( $args{'Target'} )) {
+        my $msg = $self->loc("Couldn't resolve target '[_1]' into a URI.", $args{'Target'});
+        $RT::Logger->warning( "$self $msg" );
+        return wantarray ? (undef, $msg) : undef;
+    }
+
+    my $base_id   = 0;
+    my $target_id = 0;
+
+
+
+
+    if ( $base->IsLocal ) {
+        my $object = $base->Object;
+        unless (UNIVERSAL::can($object, 'Id')) {
+            return (undef, $self->loc("[_1] appears to be a local object, but can't be found in the database", $args{'Base'}));
+        
+        }
+        $base_id = $object->Id if UNIVERSAL::isa($object, 'RT::Ticket');
+    }
+    if ( $target->IsLocal ) {
+        my $object = $target->Object;
+        unless (UNIVERSAL::can($object, 'Id')) {
+            return (undef, $self->loc("[_1] appears to be a local object, but can't be found in the database", $args{'Target'}));
+        
+        }
+        $target_id = $object->Id if UNIVERSAL::isa($object, 'RT::Ticket');
     }
-    unless (defined $TargetURI) {
-       $RT::Logger->warning ("$self couldn't resolve target:'".$args{'Target'}.
-                             "' into a URI\n");
-       return(undef);
+
+    # We don't want references to ourself
+    if ( $base->URI eq $target->URI ) {
+        return ( 0, $self->loc("Can't link a ticket to itself") );
     }
-    
-    my $LocalBase = $self->_IsLocal($BaseURI);
-    my $LocalTarget = $self->_IsLocal($TargetURI);
-    my $id = $self->SUPER::Create(Base => "$BaseURI",
-                                 Target => "$TargetURI",
-                                 LocalBase => $LocalBase, 
-                                 LocalTarget => $LocalTarget,
-                                 Type => $args{'Type'});
-    return ($id);
+
+    # }}}
+
+    my ( $id, $msg ) = $self->SUPER::Create( Base        => $base->URI,
+                                             Target      => $target->URI,
+                                             LocalBase   => $base_id,
+                                             LocalTarget => $target_id,
+                                             Type        => $args{'Type'} );
+    return ( $id, $msg );
 }
 
-# }}}
+ # sub LoadByParams
+
+=head2 LoadByParams
+
+  Load an RT::Link object from the database.  Takes three parameters
+  
+  Base => undef,
+  Target => undef,
+  Type =>undef
  
-# {{{ sub Load 
+  Base and Target are expected to be integers which refer to Tickets or URIs
+  Type is the link type
+
+=cut
+
+sub LoadByParams {
+    my $self = shift;
+    my %args = ( Base   => undef,
+                 Target => undef,
+                 Type   => undef,
+                 @_ );
+
+    my $base = RT::URI->new($self->CurrentUser);
+    $base->FromURI( $args{'Base'} )
+        or return (0, $self->loc("Couldn't parse Base URI: [_1]", $args{Base}));
+
+    my $target = RT::URI->new($self->CurrentUser);
+    $target->FromURI( $args{'Target'} )
+        or return (0, $self->loc("Couldn't parse Target URI: [_1]", $args{Target}));
+
+    my ( $id, $msg ) = $self->LoadByCols( Base   => $base->URI,
+                                          Type   => $args{'Type'},
+                                          Target => $target->URI );
+
+    unless ($id) {
+        return ( 0, $self->loc("Couldn't load link: [_1]", $msg) );
+    } else {
+        return ($id, $msg);
+    }
+}
+
 
 =head2 Load
 
-  Load an RT::Link object from the database.  Takes one parameter or three.
-  One parameter is the id of an entry in the links table.  Three parameters are a tuple of (base, linktype, target);
+  Load an RT::Link object from the database.  Takes one parameter, the id of an entry in the links table.
 
 
 =cut
 
-sub Load  {
-  my $self = shift;
-  my $identifier = shift;
-  my $linktype = shift if (@_);
-  my $target = shift if (@_);
-  
-  if ($target) {
-      my $BaseURI = $self->CanonicalizeURI($identifier);
-      my $TargetURI = $self->CanonicalizeURI($target);
-      $self->LoadByCols( Base => $BaseURI,
-                        Type => $linktype,
-                        Target => $TargetURI
-                      ) || return (0, "Couldn't load link");
-  }
-  
-  elsif ($identifier =~ /^\d+$/) {
-      $self->LoadById($identifier) ||
-       return (0, "Couldn't load link");
-  }
-  else {
-       return (0, "That's not a numerical id");
-  }
+sub Load {
+    my $self       = shift;
+    my $identifier = shift;
+
+
+
+
+    if ( $identifier !~ /^\d+$/ ) {
+        return ( 0, $self->loc("That's not a numerical id") );
+    }
+    else {
+        my ( $id, $msg ) = $self->LoadById($identifier);
+        unless ( $self->Id ) {
+            return ( 0, $self->loc("Couldn't load link") );
+        }
+        return ( $id, $msg );
+    }
 }
 
-# }}}
 
-# {{{ sub TargetObj 
+
+
+=head2 TargetURI
+
+returns an RT::URI object for the "Target" of this link.
+
+=cut
+
+sub TargetURI {
+    my $self = shift;
+    my $URI = RT::URI->new($self->CurrentUser);
+    $URI->FromURI($self->Target);
+    return ($URI);
+}
+
 
 =head2 TargetObj
 
 =cut
 
 sub TargetObj {
-  my $self = shift;
-   return $self->_TicketObj('base',$self->Target);
+    my $self = shift;
+    return $self->TargetURI->Object;
+}
+
+
+=head2 BaseURI
+
+returns an RT::URI object for the "Base" of this link.
+
+=cut
+
+sub BaseURI {
+    my $self = shift;
+    my $URI = RT::URI->new($self->CurrentUser);
+    $URI->FromURI($self->Base);
+    return ($URI);
 }
-# }}}
 
-# {{{ sub BaseObj
 
 =head2 BaseObj
 
@@ -140,234 +262,173 @@ sub TargetObj {
 
 sub BaseObj {
   my $self = shift;
-  return $self->_TicketObj('target',$self->Base);
+  return $self->BaseURI->Object;
 }
-# }}}
 
-# {{{ sub _TicketObj
-sub _TicketObj {
-  my $self = shift;
-  my $name = shift;
-  my $ref = shift;
-  my $tag="$name\_obj";
-  
-  unless (exists $self->{$tag}) {
 
-  $self->{$tag}=RT::Ticket->new($self->CurrentUser);
+=head2 id
 
-  #If we can get an actual ticket, load it up.
-  if ($self->_IsLocal($ref)) {
-      $self->{$tag}->Load($ref);
-    }
-  }
-  return $self->{$tag};
-}
-# }}}
+Returns the current value of id.
+(In the database, id is stored as int(11).)
 
-# {{{ sub _Accessible 
-sub _Accessible  {
-  my $self = shift;
-  my %Cols = (
-             LocalBase => 'read',
-             LocalTarget => 'read',
-             Base => 'read',
-             Target => 'read',
-             Type => 'read',
-             Creator => 'read/auto',
-             Created => 'read/auto',
-             LastUpdatedBy => 'read/auto',
-             LastUpdated => 'read/auto'
-            );
-  return($self->SUPER::_Accessible(@_, %Cols));
-}
-# }}}
 
+=cut
+
+
+=head2 Base
+
+Returns the current value of Base.
+(In the database, Base is stored as varchar(240).)
 
-# Static methods:
 
-# {{{ sub BaseIsLocal
 
-=head2 BaseIsLocal
+=head2 SetBase VALUE
+
+
+Set Base to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, Base will be stored as a varchar(240).)
 
-Returns true if the base of this link is a local ticket
 
 =cut
 
-sub BaseIsLocal {
-  my $self = shift;
-  return $self->_IsLocal($self->Base);
-}
 
-# }}}
+=head2 Target
+
+Returns the current value of Target.
+(In the database, Target is stored as varchar(240).)
+
+
+
+=head2 SetTarget VALUE
 
-# {{{ sub TargetIsLocal
 
-=head2 TargetIsLocal
+Set Target to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, Target will be stored as a varchar(240).)
 
-Returns true if the target of this link is a local ticket
 
 =cut
 
-sub TargetIsLocal {
-  my $self = shift;
-  return $self->_IsLocal($self->Target);
-}
 
-# }}}
+=head2 Type
+
+Returns the current value of Type.
+(In the database, Type is stored as varchar(20).)
+
+
 
-# {{{ sub _IsLocal
+=head2 SetType VALUE
 
-=head2 _IsLocal URI 
 
-When handed a URI returns the local ticket id if it\'s local. otherwise returns undef.
+Set Type to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, Type will be stored as a varchar(20).)
+
 
 =cut
 
-sub _IsLocal {
-    my $self = shift;
-    my $URI=shift;
-    unless ($URI) {
-       $RT::Logger->warning ("$self _IsLocal called without a URI\n");
-       return (undef);
-    }
-    # TODO: More thorough check
-    if ($URI =~ /^$RT::TicketBaseURI(\d+)$/) {
-       return($1);
-    }
-    else {
-       return (undef);
-    }
-}
-# }}}
 
+=head2 LocalTarget
+
+Returns the current value of LocalTarget.
+(In the database, LocalTarget is stored as int(11).)
 
-# {{{ sub BaseAsHREF 
 
-=head2 BaseAsHREF
 
-Returns an HTTP url to access the base of this link
+=head2 SetLocalTarget VALUE
+
+
+Set LocalTarget to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, LocalTarget will be stored as a int(11).)
+
 
 =cut
 
-sub BaseAsHREF {
-  my $self = shift;
-  return $self->AsHREF($self->Base);
-}
-# }}}
 
-# {{{ sub TargetAsHREF 
+=head2 LocalBase
+
+Returns the current value of LocalBase.
+(In the database, LocalBase is stored as int(11).)
+
+
+
+=head2 SetLocalBase VALUE
 
-=head2 TargetAsHREF
 
-return an HTTP url to access the target of this link
+Set LocalBase to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, LocalBase will be stored as a int(11).)
+
 
 =cut
 
-sub TargetAsHREF {
-  my $self = shift;
-  return $self->AsHREF($self->Target);
-}
-# }}}
 
-# {{{ sub AsHREF - Converts Link URIs to HTTP URLs
-=head2 URI
+=head2 LastUpdatedBy
+
+Returns the current value of LastUpdatedBy.
+(In the database, LastUpdatedBy is stored as int(11).)
 
-Takes a URI and returns an http: url to access that object.
 
 =cut
-sub AsHREF {
-    my $self=shift;
-    my $URI=shift;
-    if ($self->_IsLocal($URI)) {
-       my $url=$RT::WebURL . "Ticket/Display.html?id=$URI";
-       return($url);
-    } 
-    else {
-       my ($protocol) = $URI =~ m|(.*?)://|;
-       unless (exists $RT::URI2HTTP{$protocol}) {
-           $RT::Logger->warning("Linking for protocol $protocol not defined in the config file!");
-           return("");
-       }
-       return $RT::URI2HTTP{$protocol}->($URI);
-    }
-}
 
-# }}}
 
-# {{{ sub GetContent - gets the content from a link
-sub GetContent {
-    my ($self, $URI)= @_;
-    if ($self->_IsLocal($URI)) {
-       die "stub";
-    } else {
-       # Find protocol
-       if ($URI =~ m|^(.*?)://|) {
-           if (exists $RT::ContentFromURI{$1}) {
-               return $RT::ContentFromURI{$1}->($URI);
-           } else {
-               warn "No sub exists for fetching the content from a $1 in $URI";
-           }
-       } else {
-           warn "No protocol specified in $URI";
-       }
-    }
-}
-# }}}
+=head2 LastUpdated
 
-# {{{ sub CanonicalizeURI
+Returns the current value of LastUpdated.
+(In the database, LastUpdated is stored as datetime.)
 
-=head2 CanonicalizeURI
 
-Takes a single argument: some form of ticket identifier. 
-Returns its canonicalized URI.
+=cut
+
+
+=head2 Creator
+
+Returns the current value of Creator.
+(In the database, Creator is stored as int(11).)
 
-Bug: ticket aliases can't have :// in them. URIs must have :// in them.
 
 =cut
 
-sub CanonicalizeURI {
-    my $self = shift;
-    my $id = shift;
-    
-    
-    #If it's a local URI, load the ticket object and return its URI
-    if ($id =~ /^$RT::TicketBaseURI/) {
-       my $ticket = new RT::Ticket($self->CurrentUser);
-       $ticket->Load($id);
-       #If we couldn't find a ticket, return undef.
-       return undef unless (defined $ticket->Id);
-       #$RT::Logger->debug("$self -> CanonicalizeURI was passed $id and returned ".$ticket->URI ." (uri)\n");
-       return ($ticket->URI);
-    }
-    #If it's a remote URI, we're going to punt for now
-    elsif ($id =~ '://' ) {
-       return ($id);
-    }
-  
-    #If the base is an integer, load it as a ticket 
-    elsif ( $id =~ /^\d+$/ ) {
-       
-       #$RT::Logger->debug("$self -> CanonicalizeURI was passed $id. It's a ticket id.\n");
-       my $ticket = new RT::Ticket($self->CurrentUser);
-       $ticket->Load($id);
-       #If we couldn't find a ticket, return undef.
-       return undef unless (defined $ticket->Id);
-       #$RT::Logger->debug("$self returned ".$ticket->URI ." (id #)\n");
-       return ($ticket->URI);
-    }
 
-    #It's not a URI. It's not a numerical ticket ID
-    else { 
-     
-       #If we couldn't find a ticket, return undef.
-       return( undef);
-    
-    }
+=head2 Created
+
+Returns the current value of Created.
+(In the database, Created is stored as datetime.)
+
+
+=cut
 
-}
 
-# }}}
+
+sub _CoreAccessible {
+    {
+
+        id =>
+               {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
+        Base =>
+               {read => 1, write => 1, sql_type => 12, length => 240,  is_blob => 0,  is_numeric => 0,  type => 'varchar(240)', default => ''},
+        Target =>
+               {read => 1, write => 1, sql_type => 12, length => 240,  is_blob => 0,  is_numeric => 0,  type => 'varchar(240)', default => ''},
+        Type =>
+               {read => 1, write => 1, sql_type => 12, length => 20,  is_blob => 0,  is_numeric => 0,  type => 'varchar(20)', default => ''},
+        LocalTarget =>
+               {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
+        LocalBase =>
+               {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
+        LastUpdatedBy =>
+               {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
+        LastUpdated =>
+               {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
+        Creator =>
+               {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
+        Created =>
+               {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
+
+ }
+};
+
+RT::Base->_ImportOverlays();
 
 1;