--- /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;