ExtractCustomFieldValues extension for RT, #9728

3 files changed, 380 insertions, 0 deletions

diff --git a/rt/lib/RT/Action/ExtractCustomFieldValues.pm b/rt/lib/RT/Action/ExtractCustomFieldValues.pm
new file mode 100644
index 0000000..15aa469
--- /dev/null
+++ b/rt/lib/RT/Action/ExtractCustomFieldValues.pm
@@ -0,0 +1,234 @@
+package RT::Action::ExtractCustomFieldValues;
+require RT::Action;
+
+use strict;
+use warnings;
+
+use base qw(RT::Action);
+
+our $VERSION = 2.99_01;
+
+sub Describe {
+    my $self = shift;
+    return ( ref $self );
+}
+
+sub Prepare {
+    return (1);
+}
+
+sub FirstAttachment {
+    my $self = shift;
+    return $self->TransactionObj->Attachments->First;
+}
+
+sub Queue {
+    my $self = shift;
+    return $self->TicketObj->QueueObj->Id;
+}
+
+sub TemplateContent {
+    my $self = shift;
+    return $self->TemplateObj->Content;
+}
+
+sub TemplateConfig {
+    my $self = shift;
+
+    my ($content, $error) = $self->TemplateContent;
+    if (!defined($content)) {
+        return (undef, $error);
+    }
+
+    my $Separator = '\|';
+    my @lines = split( /[\n\r]+/, $content);
+    my @results;
+    for (@lines) {
+        chomp;
+        next if /^#/;
+        next if /^\s*$/;
+        if (/^Separator=(.+)$/) {
+            $Separator = $1;
+            next;
+        }
+        my %line;
+        @line{qw/CFName Field Match PostEdit Options/}
+            = split(/$Separator/);
+        $_ = '' for grep !defined, values %line;
+        push @results, \%line;
+    }
+    return \@results;
+}
+
+sub Commit {
+    my $self            = shift;
+    return 1 unless $self->FirstAttachment;
+
+    my ($config_lines, $error) = $self->TemplateConfig;
+
+    return 0 if $error;
+
+    for my $config (@$config_lines) {
+        my %config = %{$config};
+        $RT::Logger->debug( "Looking to extract: "
+                . join( " ", map {"$_=$config{$_}"} sort keys %config ) );
+
+        if ( $config{Options} =~ /\*/ ) {
+            $self->FindContent(
+                %config,
+                Callback    => sub {
+                    my $content = shift;
+                    my $found = 0;
+                    while ( $content =~ /$config{Match}/mg ) {
+                        my ( $cf, $value ) = ( $1, $2 );
+                        $cf = $self->LoadCF( Name => $cf, Quiet => 1 );
+                        next unless $cf;
+                        $found++;
+                        $self->ProcessCF(
+                            %config,
+                            CustomField => $cf,
+                            Value       => $value
+                        );
+                    }
+                    return $found;
+                },
+            );
+        } else {
+            my $cf;
+            $cf = $self->LoadCF( Name => $config{CFName} )
+                if $config{CFName};
+
+            $self->FindContent(
+                %config,
+                Callback    => sub {
+                    my $content = shift;
+                    return 0 unless $content =~ /($config{Match})/m;
+                    $self->ProcessCF(
+                        %config,
+                        CustomField => $cf,
+                        Value       => $2 || $1,
+                    );
+                    return 1;
+                }
+            );
+        }
+    }
+    return (1);
+}
+
+sub LoadCF {
+    my $self = shift;
+    my %args            = @_;
+    my $CustomFieldName = $args{Name};
+    $RT::Logger->debug( "Looking for CF $CustomFieldName");
+
+    # We do this by hand instead of using LoadByNameAndQueue because
+    # that can find disabled queues
+    my $cfs = RT::CustomFields->new($RT::SystemUser);
+    $cfs->LimitToGlobalOrQueue($self->Queue);
+    $cfs->Limit(
+        FIELD         => 'Name',
+        VALUE         => $CustomFieldName,
+        CASESENSITIVE => 0
+    );
+    $cfs->RowsPerPage(1);
+
+    my $cf = $cfs->First;
+    if ( $cf && $cf->id ) {
+        $RT::Logger->debug( "Found CF id " . $cf->id );
+    } elsif ( not $args{Quiet} ) {
+        $RT::Logger->error( "Couldn't load CF $CustomFieldName!");
+    }
+
+    return $cf;
+}
+
+sub FindContent {
+    my $self = shift;
+    my %args = @_;
+    if ( lc $args{Field} eq "body" ) {
+        my $Attachments  = $self->TransactionObj->Attachments;
+        my $LastContent  = '';
+        my $AttachmentCount = 0;
+
+        my @list = @{ $Attachments->ItemsArrayRef };
+        while ( my $Message = shift @list ) {
+            $AttachmentCount++;
+            $RT::Logger->debug( "Looking at attachment $AttachmentCount, content-type "
+                                    . $Message->ContentType );
+            my $ct = $Message->ContentType;
+            unless ( $ct =~ m!^(text/plain|message|text$)!i ) {
+                # don't skip one attachment that is text/*
+                next if @list > 1 || $ct !~ m!^text/!;
+            }
+
+            my $content = $Message->Content;
+            next unless $content;
+            next if $LastContent eq $content;
+            $RT::Logger->debug( "Examining content of body" );
+            $LastContent = $content;
+            $args{Callback}->( $content );
+        }
+    } elsif ( lc $args{Field} eq 'headers' ) {
+        my $attachment = $self->FirstAttachment;
+        $RT::Logger->debug( "Looking at the headers of the first attachment" );
+        my $content = $attachment->Headers;
+        return unless $content;
+        $RT::Logger->debug( "Examining content of headers" );
+        $args{Callback}->( $content );
+    } else {
+        my $attachment = $self->FirstAttachment;
+        $RT::Logger->debug( "Looking at $args{Field} header of first attachment" );
+        my $content = $attachment->GetHeader( $args{Field} );
+        return unless defined $content;
+        $RT::Logger->debug( "Examining content of header" );
+        $args{Callback}->( $content );
+    }
+}
+
+sub ProcessCF {
+    my $self = shift;
+    my %args = @_;
+
+    return $self->PostEdit(%args)
+        unless $args{CustomField};
+
+    my @values = ();
+    if ( $args{CustomField}->SingleValue() ) {
+        push @values, $args{Value};
+    } else {
+        @values = split( ',', $args{Value} );
+    }
+
+    foreach my $value ( grep defined && length, @values ) {
+        $value = $self->PostEdit(%args, Value => $value );
+        next unless defined $value && length $value;
+
+        $RT::Logger->debug( "Found value for CF: $value");
+        my ( $id, $msg ) = $self->TicketObj->AddCustomFieldValue(
+            Field             => $args{CustomField},
+            Value             => $value,
+            RecordTransaction => $args{Options} =~ /q/ ? 0 : 1
+        );
+        $RT::Logger->info( "CustomFieldValue ("
+                . $args{CustomField}->Name
+                . ",$value) added: $id $msg" );
+    }
+}
+
+sub PostEdit {
+    my $self = shift;
+    my %args = @_;
+
+    return $args{Value} unless $args{Value} && $args{PostEdit};
+
+    $RT::Logger->debug( "Running PostEdit for '$args{Value}'");
+    my $value = $args{Value};
+    local $_  = $value;    # backwards compatibility
+    local $@;
+    eval( $args{PostEdit} );
+    $RT::Logger->error("$@") if $@;
+    return $value;
+}
+
+1;
diff --git a/rt/lib/RT/Action/ExtractCustomFieldValuesWithCodeInTemplate.pm b/rt/lib/RT/Action/ExtractCustomFieldValuesWithCodeInTemplate.pm
new file mode 100644
index 0000000..e05966b
--- /dev/null
+++ b/rt/lib/RT/Action/ExtractCustomFieldValuesWithCodeInTemplate.pm
@@ -0,0 +1,30 @@
+package RT::Action::ExtractCustomFieldValuesWithCodeInTemplate;
+use strict;
+use warnings;
+
+use base qw(RT::Action::ExtractCustomFieldValues);
+
+sub TemplateContent {
+    my $self = shift;
+    my $is_broken = 0;
+
+    my $content = $self->TemplateObj->Content;
+
+    my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $content);
+    my $new_content = $template->fill_in(
+        BROKEN => sub {
+            my (%args) = @_;
+            $RT::Logger->error("Template parsing error: $args{error}")
+                unless $args{error} =~ /^Died at /; # ignore intentional die()
+            $is_broken++;
+            return undef;
+        },
+    );
+
+    return (undef, $self->loc('Template parsing error')) if $is_broken;
+
+    return $new_content;
+}
+
+1;
+
diff --git a/rt/lib/RT/Extension/ExtractCustomFieldValues.pm b/rt/lib/RT/Extension/ExtractCustomFieldValues.pm
new file mode 100644
index 0000000..6731cf4
--- /dev/null
+++ b/rt/lib/RT/Extension/ExtractCustomFieldValues.pm
@@ -0,0 +1,116 @@
+use warnings;
+use strict;
+
+package RT::Extension::ExtractCustomFieldValues;
+
+=head1 NAME
+
+RT::Extension::ExtractCustomFieldValues - extract CF values from email headers or body
+
+=cut
+
+our $VERSION = '3.07';
+
+1;
+
+=head1 DESCRIPTION
+
+ExtractCustomFieldValues is based on a scrip action
+"ExtractCustomFieldValues", which can be used to scan incoming emails
+to set values of custom fields.
+
+=head1 INSTALLATION
+
+    perl Makefile.PL
+    make
+    make install
+    make initdb # first time only, not on upgrades
+
+When using this extension with RT 3.8, you will need to add
+extension to the Plugins configuration:
+
+    Set( @Plugins, qw(... RT::Extension::ExtractCustomFieldValues) );
+
+If you are upgrading this extension from 3.05 or earlier, you will
+need to read the UPGRADING file after running make install to add 
+the new Scrip Action.
+
+=head1 USAGE
+
+To use the ScripAction, create a Template and a Scrip in RT.
+Your new Scrip should use a ScripAction of 'Extract Custom Field Values'.
+The Template consists of the lines which control the scanner. All
+non-comment lines are of the following format:
+
+    <cf-name>|<Headername>|<MatchString>|<Postcmd>|<Options>
+
+where:
+
+=over 4
+
+=item <cf-name> - the name of a custom field (must be created in RT) If this
+field is blank, the match will be run and Postcmd will be executed, but no
+custom field will be updated. Use this if you need to execute other RT code
+based on your match.
+
+=item <Headername> - either a Name of an email header, "body" to scan the body
+of the email or "headers" to search all of the headers.
+
+=item <MatchString> - a regular expression to find a match in the header or
+body if the MatchString matches a comma separated list and the CF is a multi
+value CF then each item in the list is added as a separate value.
+
+=item <Postcmd>  - a perl code to be evaluated on C<$value>, where C<$value> is
+either $1 or full match text from the match performed with <MatchString>
+
+=item <Options> - a string of letters which may control some aspects.  Possible
+options include:
+
+=over 4
+
+=item 'q' - (quiet) Don't record a transaction when adding the custom field value
+
+=item '*' - (wildcard) The MatchString regex should contain _two_ capturing
+groups, the first of which is the CF name, the second of which is the value.
+If this option is given, the <cf-name> field is ignored.
+
+=back
+
+=back
+
+=head2 Separator
+
+You can change the separator string (initially "\|") during the
+template with:
+
+    Separator=<anyregexp>
+
+Changing the separator may be necessary, if you want to use a "|" in
+one of the patterns in the controlling lines.
+
+=head2 Example and further reading
+
+An example template with some further examples is installed during
+"make install" or "make insert-template". See the
+CustomFieldScannerExample template for examples and further
+documentation.
+
+=head1 AUTHOR
+
+This extension was originally written by Dirk Pape
+E<lt>pape@inf.fu-berlin.deE<gt>.
+
+This version is modified by Best Practical for customer use
+and maintained by Best Practical Solutions.
+
+=head1 BUGS
+
+Report bugs using L<http://rt.cpan.org> service, discuss on RT's
+mailing lists, see also L</SUPPORT>
+
+=head1 SUPPORT
+
+Support requests should be referred to Best Practical
+E<lt>sales@bestpractical.comE<gt>.  
+
+=cut