rt 4.2.13 ticket#13852

[freeside.git] / rt / lib / RT / Interface / REST.pm

diff --git a/rt/lib/RT/Interface/REST.pm b/rt/lib/RT/Interface/REST.pm
index 5f8ff99..24c4bba 100644 (file)
--- a/rt/lib/RT/Interface/REST.pm
+++ b/rt/lib/RT/Interface/REST.pm
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2016 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -47,12 +47,13 @@
 # END BPS TAGGED BLOCK }}}
 
 package RT::Interface::REST;
+use LWP::MediaTypes qw(guess_media_type);
 use strict;
 use warnings;
 use RT;
 
 use base 'Exporter';
-our @EXPORT = qw(expand_list form_parse form_compose vpush vsplit);
+our @EXPORT = qw(expand_list form_parse form_compose vpush vsplit process_attachments);
 
 sub custom_field_spec {
     my $self    = shift;
@@ -282,20 +283,100 @@ sub vpush {
 
 # "Normalise" a hash key that's known to be multi-valued.
 sub vsplit {
-    my ($val) = @_;
+    my ($val, $strip) = @_;
     my @words;
-
-    foreach my $line (map {split /\n/} (ref $val eq 'ARRAY') ? @$val : ($val||''))
-    {
-        # XXX: This should become a real parser, ? la Text::ParseWords.
-        $line =~ s/^\s+//;
-        $line =~ s/\s+$//;
-        push @words, split /\s*,\s*/, $line;
+    my @values = map {split /\n/} (ref $val eq 'ARRAY' ? @$val : $val);
+
+    foreach my $line (@values) {
+        while ($line =~ /\S/) {
+            $line =~ s/^
+                       \s*   # Trim leading whitespace
+                       (?:
+                           (")   # Quoted string
+                           ((?>[^\\"]*(?:\\.[^\\"]*)*))"
+                       |
+                           (')   # Single-quoted string
+                           ((?>[^\\']*(?:\\.[^\\']*)*))'
+                       |
+                           q\{(.*?)\}  # A perl-ish q{} string; this does
+                                     # no paren balancing, however, and
+                                     # only exists for back-compat
+                       |
+                           (.*?)     # Anything else, until the next comma
+                       )
+                       \s*   # Trim trailing whitespace
+                       (?:
+                           \Z  # Finish at end-of-line
+                       |
+                           ,   # Or a comma
+                       )
+                      //xs or last; # There should be no way this match
+                                    # fails, but add a failsafe to
+                                    # prevent infinite-looping if it
+                                    # somehow does.
+            my ($quote, $quoted) = ($1 ? ($1, $2) : $3 ? ($3, $4) : ('', $5 || $6));
+            # Only unquote the quote character, or the backslash -- and
+            # only if we were originally quoted..
+            if ($5) {
+                $quoted =~ s/([\\'])/\\$1/g;
+                $quote = "'";
+            }
+            if ($strip) {
+                $quoted =~ s/\\([\\$quote])/$1/g if $quote;
+                push @words, $quoted;
+            } else {
+                push @words, "$quote$quoted$quote";
+            }
+        }
     }
-
     return \@words;
 }
 
+sub process_attachments {
+    my $entity = shift;
+    my @list = @_;
+    return 1 unless @list;
+
+    my $m = $HTML::Mason::Commands::m;
+    my $cgi = $m->cgi_object;
+
+    my $i = 1;
+    foreach my $e ( @list ) {
+
+        my $fh = $cgi->upload("attachment_$i");
+        return (0, "No attachment for $e") unless $fh;
+
+        local $/=undef;
+
+        my $file = $e;
+        $file =~ s#^.*[\\/]##;
+
+        my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+
+        my $buf;
+        while (sysread($fh, $buf, 8192)) {
+            syswrite($tmp_fh, $buf);
+        }
+
+        my $info = $cgi->uploadInfo($fh);
+        # If Content-ID exists for attachment then we need multipart/related
+        # to be able to refer to this Content-Id in core of mime message
+        if($info->{'Content-ID'}) {
+            $entity->head->set('Content-Type', 'multipart/related');
+        }
+        my $new_entity = $entity->attach(
+            Path => $tmp_fn,
+            Type => $info->{'Content-Type'} || guess_media_type($tmp_fn),
+            Filename => $file,
+            Disposition => $info->{'Content-Disposition'} || "attachment",
+            'Content-ID' => $info->{'Content-ID'},
+        );
+        $new_entity->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
+        $i++;
+    }
+    return (1);
+}
+
 RT::Base->_ImportOverlays();
 
 1;