rt 4.0.23
[freeside.git] / rt / lib / RT / Record.pm
index 313888c..634a02e 100755 (executable)
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -71,7 +71,6 @@ use RT::Date;
 use RT::I18N;
 use RT::User;
 use RT::Attributes;
-use Encode qw();
 
 our $_TABLE_ATTR = { };
 use base RT->Config->Get('RecordBaseClass');
@@ -501,19 +500,24 @@ sub _Set {
     # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
     # we want to change the standard "success" message
     if ($status) {
-        $msg =
-          $self->loc(
-            "[_1] changed from [_2] to [_3]",
-            $self->loc( $args{'Field'} ),
-            ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
-            '"' . $self->__Value( $args{'Field'}) . '"' 
-          );
-      } else {
-
-          $msg = $self->CurrentUser->loc_fuzzy($msg);
+        if ($self->SQLType( $args{'Field'}) =~ /text/) {
+            $msg = $self->loc(
+                "[_1] updated",
+                $self->loc( $args{'Field'} ),
+            );
+        } else {
+            $msg = $self->loc(
+                "[_1] changed from [_2] to [_3]",
+                $self->loc( $args{'Field'} ),
+                ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
+                '"' . $self->__Value( $args{'Field'}) . '"',
+            );
+        }
+    } else {
+        $msg = $self->CurrentUser->loc_fuzzy($msg);
     }
-    return wantarray ? ($status, $msg) : $ret;     
 
+    return wantarray ? ($status, $msg) : $ret;
 }
 
 
@@ -641,12 +645,16 @@ sub __Value {
 
     return undef if (!defined $value);
 
+    # Pg returns character columns as character strings; mysql and
+    # sqlite return them as bytes.  While mysql can be made to return
+    # characters, using the mysql_enable_utf8 flag, the "Content" column
+    # is bytes on mysql and characters on Postgres, making true
+    # consistency impossible.
     if ( $args{'decode_utf8'} ) {
-        if ( !utf8::is_utf8($value) ) {
+        if ( !utf8::is_utf8($value) ) { # mysql/sqlite
             utf8::decode($value);
         }
-    }
-    else {
+    } else {
         if ( utf8::is_utf8($value) ) {
             utf8::encode($value);
         }
@@ -660,7 +668,6 @@ sub __Value {
 
 sub _CacheConfig {
   {
-     'cache_p'        => 1,
      'cache_for_sec'  => 30,
   }
 }
@@ -725,87 +732,124 @@ sub _Accessible  {
 
 }
 
-=head2 _EncodeLOB BODY MIME_TYPE
+=head2 _EncodeLOB BODY MIME_TYPE FILENAME
+
+Takes a potentially large attachment. Returns (ContentEncoding,
+EncodedBody, MimeType, Filename) based on system configuration and
+selected database.  Returns a custom (short) text/plain message if
+DropLongAttachments causes an attachment to not be stored.
 
-Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
+Encodes your data as base64 or Quoted-Printable as needed based on your
+Databases's restrictions and the UTF-8ness of the data being passed in.  Since
+we are storing in columns marked UTF8, we must ensure that binary data is
+encoded on databases which are strict.
+
+This function expects to receive an octet string in order to properly
+evaluate and encode it.  It will return an octet string.
 
 =cut
 
 sub _EncodeLOB {
-        my $self = shift;
-        my $Body = shift;
-        my $MIMEType = shift || '';
-        my $Filename = shift;
-
-        my $ContentEncoding = 'none';
+    my $self = shift;
+    my $Body = shift;
+    my $MIMEType = shift || '';
+    my $Filename = shift;
 
-        #get the max attachment length from RT
-        my $MaxSize = RT->Config->Get('MaxAttachmentSize');
+    my $ContentEncoding = 'none';
 
-        #if the current attachment contains nulls and the
-        #database doesn't support embedded nulls
+    RT::Util::assert_bytes( $Body );
 
-        if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
+    #get the max attachment length from RT
+    my $MaxSize = RT->Config->Get('MaxAttachmentSize');
 
-            # set a flag telling us to mimencode the attachment
-            $ContentEncoding = 'base64';
+    #if the current attachment contains nulls and the
+    #database doesn't support embedded nulls
 
-            #cut the max attchment size by 25% (for mime-encoding overhead.
-            $RT::Logger->debug("Max size is $MaxSize");
-            $MaxSize = $MaxSize * 3 / 4;
-        # Some databases (postgres) can't handle non-utf8 data
-        } elsif (    !$RT::Handle->BinarySafeBLOBs
-                  && $MIMEType !~ /text\/plain/gi
-                  && !Encode::is_utf8( $Body, 1 ) ) {
-              $ContentEncoding = 'quoted-printable';
-        }
+    if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
 
-        #if the attachment is larger than the maximum size
-        if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
+        # set a flag telling us to mimencode the attachment
+        $ContentEncoding = 'base64';
 
-            # if we're supposed to truncate large attachments
-            if (RT->Config->Get('TruncateLongAttachments')) {
+        #cut the max attchment size by 25% (for mime-encoding overhead.
+        $RT::Logger->debug("Max size is $MaxSize");
+        $MaxSize = $MaxSize * 3 / 4;
+    # Some databases (postgres) can't handle non-utf8 data
+    } elsif (    !$RT::Handle->BinarySafeBLOBs
+              && $Body =~ /\P{ASCII}/
+              && !Encode::is_utf8( $Body, 1 ) ) {
+          $ContentEncoding = 'quoted-printable';
+    }
 
-                # truncate the attachment to that length.
-                $Body = substr( $Body, 0, $MaxSize );
+    #if the attachment is larger than the maximum size
+    if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
 
-            }
+        # if we're supposed to truncate large attachments
+        if (RT->Config->Get('TruncateLongAttachments')) {
 
-            # elsif we're supposed to drop large attachments on the floor,
-            elsif (RT->Config->Get('DropLongAttachments')) {
+            # truncate the attachment to that length.
+            $Body = substr( $Body, 0, $MaxSize );
 
-                # drop the attachment on the floor
-                $RT::Logger->info( "$self: Dropped an attachment of size "
-                                   . length($Body));
-                $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
-                $Filename .= ".txt" if $Filename;
-                return ("none", "Large attachment dropped", "plain/text", $Filename );
-            }
         }
 
-        # if we need to mimencode the attachment
-        if ( $ContentEncoding eq 'base64' ) {
-
-            # base64 encode the attachment
-            Encode::_utf8_off($Body);
-            $Body = MIME::Base64::encode_base64($Body);
+        # elsif we're supposed to drop large attachments on the floor,
+        elsif (RT->Config->Get('DropLongAttachments')) {
 
-        } elsif ($ContentEncoding eq 'quoted-printable') {
-            Encode::_utf8_off($Body);
-            $Body = MIME::QuotedPrint::encode($Body);
+            # drop the attachment on the floor
+            $RT::Logger->info( "$self: Dropped an attachment of size "
+                               . length($Body));
+            $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
+            $Filename .= ".txt" if $Filename;
+            return ("none", "Large attachment dropped", "text/plain", $Filename );
         }
+    }
 
+    # if we need to mimencode the attachment
+    if ( $ContentEncoding eq 'base64' ) {
+        # base64 encode the attachment
+        $Body = MIME::Base64::encode_base64($Body);
 
-        return ($ContentEncoding, $Body, $MIMEType, $Filename );
+    } elsif ($ContentEncoding eq 'quoted-printable') {
+        $Body = MIME::QuotedPrint::encode($Body);
+    }
 
+    return ($ContentEncoding, $Body, $MIMEType, $Filename );
 }
 
+=head2 _DecodeLOB C<ContentType>, C<ContentEncoding>, C<Content>
+
+Unpacks data stored in the database, which may be base64 or QP encoded
+because of our need to store binary and badly encoded data in columns
+marked as UTF-8.  Databases such as PostgreSQL and Oracle care that you
+are feeding them invalid UTF-8 and will refuse the content.  This
+function handles unpacking the encoded data.
+
+It returns textual data as a UTF-8 string which has been processed by Encode's
+PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see
+the invalid byte but won't run into problems treating the data as UTF-8 later.
+
+This is similar to how we filter all data coming in via the web UI in
+RT::Interface::Web::DecodeARGS. This filter should only end up being
+applied to old data from less UTF-8-safe versions of RT.
+
+If the passed C<ContentType> includes a character set, that will be used
+to decode textual data; the default character set is UTF-8.  This is
+necessary because while we attempt to store textual data as UTF-8, the
+definition of "textual" has migrated over time, and thus we may now need
+to attempt to decode data that was previously not trancoded on insertion.
+
+Important Note - This function expects an octet string and returns a
+character string for non-binary data.
+
+=cut
+
 sub _DecodeLOB {
     my $self            = shift;
     my $ContentType     = shift || '';
     my $ContentEncoding = shift || 'none';
     my $Content         = shift;
 
+    RT::Util::assert_bytes( $Content );
+
     if ( $ContentEncoding eq 'base64' ) {
         $Content = MIME::Base64::decode_base64($Content);
     }
@@ -816,9 +860,15 @@ sub _DecodeLOB {
         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
     }
     if ( RT::I18N::IsTextualContentType($ContentType) ) {
-       $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
+        my $entity = MIME::Entity->new();
+        $entity->head->add("Content-Type", $ContentType);
+        $entity->bodyhandle( MIME::Body::Scalar->new( $Content ) );
+        my $charset = RT::I18N::_FindOrGuessCharset($entity);
+        $charset = 'utf-8' if not $charset or not Encode::find_encoding($charset);
+
+        $Content = Encode::decode($charset,$Content,Encode::FB_PERLQQ);
     }
-        return ($Content);
+    return ($Content);
 }
 
 # A helper table for links mapping to make it easier
@@ -888,6 +938,8 @@ sub Update {
 
         $value =~ s/\r\n/\n/gs;
 
+        my $truncated_value = $self->TruncateValue($attribute, $value);
+
         # If Queue is 'General', we want to resolve the queue name for
         # the object.
 
@@ -902,8 +954,12 @@ sub Update {
                 my $name = $self->$object->Name;
                 next if $name eq $value || $name eq ($value || 0);
             };
-            next if $value eq $self->$attribute();
-            next if ($value || 0) eq $self->$attribute();
+
+            my $current = $self->$attribute();
+            # RT::Queue->Lifecycle returns a Lifecycle object instead of name
+            $current = eval { $current->Name } if ref $current;
+            next if $truncated_value eq $current;
+            next if ( $truncated_value || 0 ) eq $current;
         };
 
         $new_values{$attribute} = $value;
@@ -1361,7 +1417,7 @@ sub _AddLink {
 
     if ( $args{'Base'} and $args{'Target'} ) {
         $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
-        return ( 0, $self->loc("Can't specifiy both base and target") );
+        return ( 0, $self->loc("Can't specify both base and target") );
     }
     elsif ( $args{'Base'} ) {
         $args{'Target'} = $self->URI();
@@ -1418,7 +1474,7 @@ sub _AddLink {
 
 Delete a link. takes a paramhash of Base, Target and Type.
 Either Base or Target must be null. The null value will 
-be replaced with this ticket\'s id
+be replaced with this ticket's id
 
 =cut 
 
@@ -1439,7 +1495,7 @@ sub _DeleteLink {
 
     if ( $args{'Base'} and $args{'Target'} ) {
         $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
-        return ( 0, $self->loc("Can't specifiy both base and target") );
+        return ( 0, $self->loc("Can't specify both base and target") );
     }
     elsif ( $args{'Base'} ) {
         $args{'Target'} = $self->URI();
@@ -1633,29 +1689,37 @@ sub CustomFields {
     $cfs->SetContextObject( $self );
     # XXX handle multiple types properly
     $cfs->LimitToLookupType( $self->CustomFieldLookupType );
-    $cfs->LimitToGlobalOrObjectId(
-        $self->_LookupId( $self->CustomFieldLookupType )
-    );
+    $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId );
     $cfs->ApplySortOrder;
 
     return $cfs;
 }
 
-# TODO: This _only_ works for RT::Class classes. it doesn't work, for example,
-# for RT::IR classes.
+# TODO: This _only_ works for RT::Foo classes. it doesn't work, for
+# example, for RT::IR::Foo classes.
 
-sub _LookupId {
+sub CustomFieldLookupId {
     my $self = shift;
-    my $lookup = shift;
+    my $lookup = shift || $self->CustomFieldLookupType;
     my @classes = ($lookup =~ /RT::(\w+)-/g);
 
+    # Work on "RT::Queue", for instance
+    return $self->Id unless @classes;
+
     my $object = $self;
+    # Save a ->Load call by not calling ->FooObj->Id, just ->Foo
+    my $final = shift @classes;
     foreach my $class (reverse @classes) {
        my $method = "${class}Obj";
        $object = $object->$method;
     }
 
-    return $object->Id;
+    my $id = $object->$final;
+    unless (defined $id) {
+        my $method = "${final}Obj";
+        $id = $object->$method->Id;
+    }
+    return $id;
 }
 
 
@@ -1667,7 +1731,7 @@ Returns the path RT uses to figure out which custom fields apply to this object.
 
 sub CustomFieldLookupType {
     my $self = shift;
-    return ref($self);
+    return ref($self) || $self;
 }
 
 
@@ -1745,8 +1809,8 @@ sub _AddCustomFieldValue {
                 $i++;
                 if ( $i < $cf_values ) {
                     my ( $val, $msg ) = $cf->DeleteValueForObject(
-                        Object  => $self,
-                        Content => $value->Content
+                        Object => $self,
+                        Id     => $value->id,
                     );
                     unless ($val) {
                         return ( 0, $msg );
@@ -1762,31 +1826,14 @@ sub _AddCustomFieldValue {
             $values->RedoSearch if $i; # redo search if have deleted at least one value
         }
 
-        my ( $old_value, $old_content );
-        if ( $old_value = $values->First ) {
-            $old_content = $old_value->Content;
-            $old_content = undef if defined $old_content && !length $old_content;
-
-            my $is_the_same = 1;
-            if ( defined $args{'Value'} ) {
-                $is_the_same = 0 unless defined $old_content
-                    && lc $old_content eq lc $args{'Value'};
-            } else {
-                $is_the_same = 0 if defined $old_content;
-            }
-            if ( $is_the_same ) {
-                my $old_content = $old_value->LargeContent;
-                if ( defined $args{'LargeContent'} ) {
-                    $is_the_same = 0 unless defined $old_content
-                        && $old_content eq $args{'LargeContent'};
-                } else {
-                    $is_the_same = 0 if defined $old_content;
-                }
-            }
-
-            return $old_value->id if $is_the_same;
+        if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
+            return $entry->id;
         }
 
+        my $old_value = $values->First;
+        my $old_content;
+        $old_content = $old_value->Content if $old_value;
+
         my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
             Object       => $self,
             Content      => $args{'Value'},
@@ -1853,6 +1900,13 @@ sub _AddCustomFieldValue {
 
     # otherwise, just add a new value and record "new value added"
     else {
+        if ( !$cf->Repeated ) {
+            my $values = $cf->ValuesForObject($self);
+            if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
+                return $entry->id;
+            }
+        }
+
         my ($new_value_id, $msg) = $cf->AddValueForObject(
             Object       => $self,
             Content      => $args{'Value'},