}
);
+# -*- perl -*-
+
+@ScripActions = (
+
+ { Name => 'Extract Custom Field Values', # loc
+ Description => 'extract cf-values out of a message', # loc
+ ExecModule => 'ExtractCustomFieldValues' },
+
+ { Name => 'Extract Custom Field Values With Code in Template', # loc
+ Description => 'extract cf-values out of a message with a Text::Template template', # loc
+ ExecModule => 'ExtractCustomFieldValuesWithCodeInTemplate' }
+
+);
+
+@Templates = (
+ { Queue => '0',
+ Name => 'CustomFieldScannerExample', # loc
+ Description => 'Example Template for ExtractCustomFieldValues', # loc
+ Content => <<'EOTEXT'
+#### Syntax:
+# CF Name | Header name or "Body" | MatchString(re) | Postcmd | Options
+
+#### Allowed Options:
+
+# q - (quiet) Don't record a transaction for adding the custom field
+# value
+# * - (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.
+
+#### Examples:
+
+# 1. Put the content of the "X-MI-Test" header into the "testcf"
+# custom field:
+# testcf|X-MI-Test|.*
+
+# 2. Scan the body for Host:name and put name into the "bodycf" custom
+# field:
+# bodycf|Body|Host:\s*(\w+)
+
+# 3. Scan the "X-MI-IP" header for an IP-Adresse and get the hostname
+# by reverse-resolving it:
+# Hostname|X-MI-IP|\d+\.\d+\.\d+\.\d+|use Socket; ($value) = gethostbyaddr(inet_aton($value),AF_INET);
+
+# 4. scan the "CC" header for an many email addresses, and add them to
+# a custom field named "parsedCCs". If "parsedCCs" is a multivalue
+# CF, then this should yield separate values for all email adress
+# found.
+# parsedCCs|CC|.*|$value =~ s/^\s+//; $value =~ s/\s+$//;
+
+# 5. Looks for an "Email:" field in the body of the email, then loads
+# up that user and makes them privileged The blank first field
+# means the automatic CustomField setting is not invoked.
+# |Body|Email:\s*(.+)$|my $u = RT::User->new($RT::SystemUser); $u->LoadByEmail($value); $u->SetPrivileged(1)|
+
+# 6. Looks for any text of the form "Set CF Name: Value" in the body,
+# and sets the CF named "CF Name" to the given value, which may be
+# multi-line. The '*' option controls the wildcard nature of this
+# example.
+# Separator=!
+# !Body!^Set ([^\n:]*?):\s*((?s).*?)(?:\Z|\n\Z|\n\n)!!*
+
+# 7. Looks for the regex anywhere in the headers and stores the match
+# in the AllHeaderSearch CF
+# AllHeaderSearch|Headers|Site:\s*(\w+)
+
+# 8. If you need to dynamically build your matching, and want to trigger on headers and body
+# and invode some arbitrary code like example 5
+# Separator=~~
+# {
+# my $action = 'use My::Site; My::Site::SetSiteID( Ticket => $self->TicketObj, Site => $_ );';
+#
+# for my $regex (My::Site::ValidRegexps) {
+# for my $from ('headers', 'body') {
+# $OUT .= join '~~',
+# '', # CF name
+# $from,
+# $regex,
+# $action;
+# $OUT .= "\n";
+# }
+# }
+# }
+
+EOTEXT
+ }
+);
+
+1;
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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
projects / freeside.git / commitdiff