X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FInterface%2FREST.pm;h=24c4bbae1e5cc02d8e961cfa2ca27cc6062e9bf6;hp=aed8f39a2bb1ce1bcfe2d497fa7abd51c895222d;hb=7322f2afedcc2f427e997d1535a503613a83f088;hpb=f3c4966ed1f6ec3db7accd6dcdd3a5a3821d72a7

diff --git a/rt/lib/RT/Interface/REST.pm b/rt/lib/RT/Interface/REST.pm
index aed8f39a2..24c4bbae1 100644
--- 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-2012 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,19 +47,19 @@
 # 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;
     my $capture = shift;
 
-    my $CF_char = '[\sa-z0-9_ :()/-]';
-    my $CF_name = $CF_char . '+';
+    my $CF_name = '[^,]+';
     $CF_name = '(' . $CF_name . ')' if $capture;
 
     my $new_style = 'CF\.\{'.$CF_name.'\}';
@@ -283,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;