rt/lib/RT/Action/ExtractCustomFieldValues.pm

   1 package RT::Action::ExtractCustomFieldValues;
   2 require RT::Action;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base qw(RT::Action);
   8
   9 our $VERSION = 2.99_01;
  10
  11 sub Describe {
  12     my $self = shift;
  13     return ( ref $self );
  14 }
  15
  16 sub Prepare {
  17     return (1);
  18 }
  19
  20 sub FirstAttachment {
  21     my $self = shift;
  22     return $self->TransactionObj->Attachments->First;
  23 }
  24
  25 sub Queue {
  26     my $self = shift;
  27     return $self->TicketObj->QueueObj->Id;
  28 }
  29
  30 sub TemplateContent {
  31     my $self = shift;
  32     return $self->TemplateObj->Content;
  33 }
  34
  35 sub TemplateConfig {
  36     my $self = shift;
  37
  38     my ($content, $error) = $self->TemplateContent;
  39     if (!defined($content)) {
  40         return (undef, $error);
  41     }
  42
  43     my $Separator = '\|';
  44     my @lines = split( /[\n\r]+/, $content);
  45     my @results;
  46     for (@lines) {
  47         chomp;
  48         next if /^#/;
  49         next if /^\s*$/;
  50         if (/^Separator=(.+)$/) {
  51             $Separator = $1;
  52             next;
  53         }
  54         my %line;
  55         @line{qw/CFName Field Match PostEdit Options/}
  56             = split(/$Separator/);
  57         $_ = '' for grep !defined, values %line;
  58         push @results, \%line;
  59     }
  60     return \@results;
  61 }
  62
  63 sub Commit {
  64     my $self            = shift;
  65     return 1 unless $self->FirstAttachment;
  66
  67     my ($config_lines, $error) = $self->TemplateConfig;
  68
  69     return 0 if $error;
  70
  71     for my $config (@$config_lines) {
  72         my %config = %{$config};
  73         $RT::Logger->debug( "Looking to extract: "
  74                 . join( " ", map {"$_=$config{$_}"} sort keys %config ) );
  75
  76         if ( $config{Options} =~ /\*/ ) {
  77             $self->FindContent(
  78                 %config,
  79                 Callback    => sub {
  80                     my $content = shift;
  81                     my $found = 0;
  82                     while ( $content =~ /$config{Match}/mg ) {
  83                         my ( $cf, $value ) = ( $1, $2 );
  84                         $cf = $self->LoadCF( Name => $cf, Quiet => 1 );
  85                         next unless $cf;
  86                         $found++;
  87                         $self->ProcessCF(
  88                             %config,
  89                             CustomField => $cf,
  90                             Value       => $value
  91                         );
  92                     }
  93                     return $found;
  94                 },
  95             );
  96         } else {
  97             my $cf;
  98             $cf = $self->LoadCF( Name => $config{CFName} )
  99                 if $config{CFName};
 100
 101             $self->FindContent(
 102                 %config,
 103                 Callback    => sub {
 104                     my $content = shift;
 105                     return 0 unless $content =~ /($config{Match})/m;
 106                     $self->ProcessCF(
 107                         %config,
 108                         CustomField => $cf,
 109                         Value       => $2 || $1,
 110                     );
 111                     return 1;
 112                 }
 113             );
 114         }
 115     }
 116     return (1);
 117 }
 118
 119 sub LoadCF {
 120     my $self = shift;
 121     my %args            = @_;
 122     my $CustomFieldName = $args{Name};
 123     $RT::Logger->debug( "Looking for CF $CustomFieldName");
 124
 125     # We do this by hand instead of using LoadByNameAndQueue because
 126     # that can find disabled queues
 127     my $cfs = RT::CustomFields->new($RT::SystemUser);
 128     $cfs->LimitToGlobalOrQueue($self->Queue);
 129     $cfs->Limit(
 130         FIELD         => 'Name',
 131         VALUE         => $CustomFieldName,
 132         CASESENSITIVE => 0
 133     );
 134     $cfs->RowsPerPage(1);
 135
 136     my $cf = $cfs->First;
 137     if ( $cf && $cf->id ) {
 138         $RT::Logger->debug( "Found CF id " . $cf->id );
 139     } elsif ( not $args{Quiet} ) {
 140         $RT::Logger->error( "Couldn't load CF $CustomFieldName!");
 141     }
 142
 143     return $cf;
 144 }
 145
 146 sub FindContent {
 147     my $self = shift;
 148     my %args = @_;
 149     if ( lc $args{Field} eq "body" ) {
 150         my $Attachments  = $self->TransactionObj->Attachments;
 151         my $LastContent  = '';
 152         my $AttachmentCount = 0;
 153
 154         my @list = @{ $Attachments->ItemsArrayRef };
 155         while ( my $Message = shift @list ) {
 156             $AttachmentCount++;
 157             $RT::Logger->debug( "Looking at attachment $AttachmentCount, content-type "
 158                                     . $Message->ContentType );
 159             my $ct = $Message->ContentType;
 160             unless ( $ct =~ m!^(text/plain|message|text$)!i ) {
 161                 # don't skip one attachment that is text/*
 162                 next if @list > 1 || $ct !~ m!^text/!;
 163             }
 164
 165             my $content = $Message->Content;
 166             next unless $content;
 167             next if $LastContent eq $content;
 168             $RT::Logger->debug( "Examining content of body" );
 169             $LastContent = $content;
 170             $args{Callback}->( $content );
 171         }
 172     } elsif ( lc $args{Field} eq 'headers' ) {
 173         my $attachment = $self->FirstAttachment;
 174         $RT::Logger->debug( "Looking at the headers of the first attachment" );
 175         my $content = $attachment->Headers;
 176         return unless $content;
 177         $RT::Logger->debug( "Examining content of headers" );
 178         $args{Callback}->( $content );
 179     } else {
 180         my $attachment = $self->FirstAttachment;
 181         $RT::Logger->debug( "Looking at $args{Field} header of first attachment" );
 182         my $content = $attachment->GetHeader( $args{Field} );
 183         return unless defined $content;
 184         $RT::Logger->debug( "Examining content of header" );
 185         $args{Callback}->( $content );
 186     }
 187 }
 188
 189 sub ProcessCF {
 190     my $self = shift;
 191     my %args = @_;
 192
 193     return $self->PostEdit(%args)
 194         unless $args{CustomField};
 195
 196     my @values = ();
 197     if ( $args{CustomField}->SingleValue() ) {
 198         push @values, $args{Value};
 199     } else {
 200         @values = split( ',', $args{Value} );
 201     }
 202
 203     foreach my $value ( grep defined && length, @values ) {
 204         $value = $self->PostEdit(%args, Value => $value );
 205         next unless defined $value && length $value;
 206
 207         $RT::Logger->debug( "Found value for CF: $value");
 208         my ( $id, $msg ) = $self->TicketObj->AddCustomFieldValue(
 209             Field             => $args{CustomField},
 210             Value             => $value,
 211             RecordTransaction => $args{Options} =~ /q/ ? 0 : 1
 212         );
 213         $RT::Logger->info( "CustomFieldValue ("
 214                 . $args{CustomField}->Name
 215                 . ",$value) added: $id $msg" );
 216     }
 217 }
 218
 219 sub PostEdit {
 220     my $self = shift;
 221     my %args = @_;
 222
 223     return $args{Value} unless $args{Value} && $args{PostEdit};
 224
 225     $RT::Logger->debug( "Running PostEdit for '$args{Value}'");
 226     my $value = $args{Value};
 227     local $_  = $value;    # backwards compatibility
 228     local $@;
 229     eval( $args{PostEdit} );
 230     $RT::Logger->error("$@") if $@;
 231     return $value;
 232 }
 233
 234 1;