rt/lib/RT/Template.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
  50
  51 =head1 NAME
  52
  53   RT::Template - RT's template object
  54
  55 =head1 SYNOPSIS
  56
  57   use RT::Template;
  58
  59 =head1 DESCRIPTION
  60
  61
  62 =head1 METHODS
  63
  64
  65 =cut
  66
  67
  68 package RT::Template;
  69
  70 use strict;
  71 use warnings;
  72
  73 use base 'RT::Record';
  74
  75 use RT::Queue;
  76
  77 use Text::Template;
  78 use MIME::Entity;
  79 use MIME::Parser;
  80 use Scalar::Util 'blessed';
  81
  82 sub _Accessible {
  83     my $self = shift;
  84     my %Cols = (
  85         id            => 'read',
  86         Name          => 'read/write',
  87         Description   => 'read/write',
  88         Type          => 'read/write',    #Type is one of Perl or Simple
  89         Content       => 'read/write',
  90         Queue         => 'read/write',
  91         Creator       => 'read/auto',
  92         Created       => 'read/auto',
  93         LastUpdatedBy => 'read/auto',
  94         LastUpdated   => 'read/auto'
  95     );
  96     return $self->SUPER::_Accessible( @_, %Cols );
  97 }
  98
  99 sub _Set {
 100     my $self = shift;
 101     my %args = (
 102         Field => undef,
 103         Value => undef,
 104         @_,
 105     );
 106
 107     unless ( $self->CurrentUserHasQueueRight('ModifyTemplate') ) {
 108         return ( 0, $self->loc('Permission Denied') );
 109     }
 110
 111     if (exists $args{Value}) {
 112         if ($args{Field} eq 'Queue') {
 113             if ($args{Value}) {
 114                 # moving to another queue
 115                 my $queue = RT::Queue->new( $self->CurrentUser );
 116                 $queue->Load($args{Value});
 117                 unless ($queue->Id and $queue->CurrentUserHasRight('ModifyTemplate')) {
 118                     return ( 0, $self->loc('Permission Denied') );
 119                 }
 120             } else {
 121                 # moving to global
 122                 unless ($self->CurrentUser->HasRight( Object => RT->System, Right => 'ModifyTemplate' )) {
 123                     return ( 0, $self->loc('Permission Denied') );
 124                 }
 125             }
 126         }
 127     }
 128
 129     return $self->SUPER::_Set( @_ );
 130 }
 131
 132 =head2 _Value
 133
 134 Takes the name of a table column. Returns its value as a string,
 135 if the user passes an ACL check, otherwise returns undef.
 136
 137 =cut
 138
 139 sub _Value {
 140     my $self  = shift;
 141
 142     unless ( $self->CurrentUserCanRead() ) {
 143         return undef;
 144     }
 145     return $self->__Value( @_ );
 146
 147 }
 148
 149 =head2 Load <identifier>
 150
 151 Load a template, either by number or by name.
 152
 153 Note that loading templates by name using this method B<is
 154 ambiguous>. Several queues may have template with the same name
 155 and as well global template with the same name may exist.
 156 Use L</LoadByName>, L</LoadGlobalTemplate> or L<LoadQueueTemplate> to get
 157 precise result.
 158
 159 =cut
 160
 161 sub Load {
 162     my $self       = shift;
 163     my $identifier = shift;
 164     return undef unless $identifier;
 165
 166     if ( $identifier =~ /\D/ ) {
 167         return $self->LoadByCol( 'Name', $identifier );
 168     }
 169     return $self->LoadById( $identifier );
 170 }
 171
 172 =head2 LoadByName
 173
 174 Takes Name and Queue arguments. Tries to load queue specific template
 175 first, then global. If Queue argument is omitted then global template
 176 is tried, not template with the name in any queue.
 177
 178 =cut
 179
 180 sub LoadByName {
 181     my $self = shift;
 182     my %args = (
 183         Queue => undef,
 184         Name  => undef,
 185         @_
 186     );
 187     my $queue = $args{'Queue'};
 188     if ( blessed $queue ) {
 189         $queue = $queue->id;
 190     } elsif ( defined $queue and $queue =~ /\D/ ) {
 191         my $tmp = RT::Queue->new( $self->CurrentUser );
 192         $tmp->Load($queue);
 193         $queue = $tmp->id;
 194     }
 195
 196     return $self->LoadGlobalTemplate( $args{'Name'} ) unless $queue;
 197
 198     $self->LoadQueueTemplate( Queue => $queue, Name => $args{'Name'} );
 199     return $self->id if $self->id;
 200     return $self->LoadGlobalTemplate( $args{'Name'} );
 201 }
 202
 203 =head2 LoadGlobalTemplate NAME
 204
 205 Load the global template with the name NAME
 206
 207 =cut
 208
 209 sub LoadGlobalTemplate {
 210     my $self = shift;
 211     my $name = shift;
 212
 213     return ( $self->LoadQueueTemplate( Queue => 0, Name => $name ) );
 214 }
 215
 216 =head2 LoadQueueTemplate (Queue => QUEUEID, Name => NAME)
 217
 218 Loads the Queue template named NAME for Queue QUEUE.
 219
 220 Note that this method doesn't load a global template with the same name
 221 if template in the queue doesn't exist. Use L</LoadByName>.
 222
 223 =cut
 224
 225 sub LoadQueueTemplate {
 226     my $self = shift;
 227     my %args = (
 228         Queue => undef,
 229         Name  => undef,
 230         @_
 231     );
 232
 233     return ( $self->LoadByCols( Name => $args{'Name'}, Queue => $args{'Queue'} ) );
 234
 235 }
 236
 237 =head2 Create
 238
 239 Takes a paramhash of Content, Queue, Name and Description.
 240 Name should be a unique string identifying this Template.
 241 Description and Content should be the template's title and content.
 242 Queue should be 0 for a global template and the queue # for a queue-specific
 243 template.
 244
 245 Returns the Template's id # if the create was successful. Returns undef for
 246 unknown database failure.
 247
 248 =cut
 249
 250 sub Create {
 251     my $self = shift;
 252     my %args = (
 253         Content     => undef,
 254         Queue       => 0,
 255         Description => '[no description]',
 256         Type        => 'Perl',
 257         Name        => undef,
 258         @_
 259     );
 260
 261     if ( $args{Type} eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System) ) {
 262         return ( undef, $self->loc('Permission Denied') );
 263     }
 264
 265     unless ( $args{'Queue'} ) {
 266         unless ( $self->CurrentUser->HasRight(Right =>'ModifyTemplate', Object => $RT::System) ) {
 267             return ( undef, $self->loc('Permission Denied') );
 268         }
 269         $args{'Queue'} = 0;
 270     }
 271     else {
 272         my $QueueObj = RT::Queue->new( $self->CurrentUser );
 273         $QueueObj->Load( $args{'Queue'} ) || return ( undef, $self->loc('Invalid queue') );
 274
 275         unless ( $QueueObj->CurrentUserHasRight('ModifyTemplate') ) {
 276             return ( undef, $self->loc('Permission Denied') );
 277         }
 278         $args{'Queue'} = $QueueObj->Id;
 279     }
 280
 281     return ( undef, $self->loc('Name is required') )
 282         unless $args{Name};
 283
 284     {
 285         my $tmp = $self->new( RT->SystemUser );
 286         $tmp->LoadByCols( Name => $args{'Name'}, Queue => $args{'Queue'} );
 287         return ( undef, $self->loc('A Template with that name already exists') )
 288             if $tmp->id;
 289     }
 290
 291     my ( $result, $msg ) = $self->SUPER::Create(
 292         Content     => $args{'Content'},
 293         Queue       => $args{'Queue'},
 294         Description => $args{'Description'},
 295         Name        => $args{'Name'},
 296         Type        => $args{'Type'},
 297     );
 298
 299     if ( wantarray ) {
 300         return ( $result, $msg );
 301     } else {
 302         return ( $result );
 303     }
 304
 305 }
 306
 307 =head2 Delete
 308
 309 Delete this template.
 310
 311 =cut
 312
 313 sub Delete {
 314     my $self = shift;
 315
 316     unless ( $self->CurrentUserHasQueueRight('ModifyTemplate') ) {
 317         return ( 0, $self->loc('Permission Denied') );
 318     }
 319
 320     if ( !$self->IsOverride && $self->UsedBy->Count ) {
 321         return ( 0, $self->loc('Template is in use') );
 322     }
 323
 324     return ( $self->SUPER::Delete(@_) );
 325 }
 326
 327 =head2 UsedBy
 328
 329 Returns L<RT::Scrips> limitted to scrips that use this template. Takes
 330 into account that template can be overriden in a queue.
 331
 332 =cut
 333
 334 sub UsedBy {
 335     my $self = shift;
 336
 337     my $scrips = RT::Scrips->new( $self->CurrentUser );
 338     $scrips->LimitByTemplate( $self );
 339     return $scrips;
 340 }
 341
 342 =head2 IsEmpty
 343
 344 Returns true value if content of the template is empty, otherwise
 345 returns false.
 346
 347 =cut
 348
 349 sub IsEmpty {
 350     my $self = shift;
 351     my $content = $self->Content;
 352     return 0 if defined $content && length $content;
 353     return 1;
 354 }
 355
 356 =head2 IsOverride
 357
 358 Returns true if it's queue specific template and there is global
 359 template with the same name.
 360
 361 =cut
 362
 363 sub IsOverride {
 364     my $self = shift;
 365     return 0 unless $self->Queue;
 366
 367     my $template = RT::Template->new( $self->CurrentUser );
 368     $template->LoadGlobalTemplate( $self->Name );
 369     return $template->id;
 370 }
 371
 372
 373 =head2 MIMEObj
 374
 375 Returns L<MIME::Entity> object parsed using L</Parse> method. Returns
 376 undef if last call to L</Parse> failed or never be called.
 377
 378 Note that content of the template is characters, but the contents of all
 379 L<MIME::Entity> objects (including the one returned by this function,
 380 are bytes in UTF-8.
 381
 382 =cut
 383
 384 sub MIMEObj {
 385     my $self = shift;
 386     return ( $self->{'MIMEObj'} );
 387 }
 388
 389 =head2 Parse
 390
 391 This routine performs L<Text::Template> parsing on the template and then
 392 imports the results into a L<MIME::Entity> so we can really use it. Use
 393 L</MIMEObj> method to get the L<MIME::Entity> object.
 394
 395 Takes a hash containing Argument, TicketObj, and TransactionObj and other
 396 arguments that will be available in the template's code. TicketObj and
 397 TransactionObj are not mandatory, but highly recommended.
 398
 399 It returns a tuple of (val, message). If val is false, the message contains
 400 an error message.
 401
 402 =cut
 403
 404 sub Parse {
 405     my $self = shift;
 406     my ($rv, $msg);
 407
 408
 409     if (not $self->IsEmpty and $self->Content =~ m{^Content-Type:\s+text/html\b}im) {
 410         local $RT::Transaction::PreferredContentType = 'text/html';
 411         ($rv, $msg) = $self->_Parse(@_);
 412     }
 413     else {
 414         ($rv, $msg) = $self->_Parse(@_);
 415     }
 416
 417     return ($rv, $msg) unless $rv;
 418
 419     my $mime_type   = $self->MIMEObj->mime_type;
 420     if (defined $mime_type and $mime_type eq 'text/html') {
 421         $self->_DowngradeFromHTML(@_);
 422     }
 423
 424     return ($rv, $msg);
 425 }
 426
 427 sub _Parse {
 428     my $self = shift;
 429
 430     # clear prev MIME object
 431     $self->{'MIMEObj'} = undef;
 432
 433     #We're passing in whatever we were passed. it's destined for _ParseContent
 434     my ($content, $msg) = $self->_ParseContent(@_);
 435     return ( 0, $msg ) unless defined $content && length $content;
 436
 437     if ( $content =~ /^\S/s && $content !~ /^\S+:/ ) {
 438         $RT::Logger->error(
 439             "Template #". $self->id ." has leading line that doesn't"
 440             ." look like header field, if you don't want to override"
 441             ." any headers and don't want to see this error message"
 442             ." then leave first line of the template empty"
 443         );
 444         $content = "\n".$content;
 445     }
 446
 447     my $parser = MIME::Parser->new();
 448     $parser->output_to_core(1);
 449     $parser->tmp_to_core(1);
 450     $parser->use_inner_files(1);
 451
 452     ### Should we forgive normally-fatal errors?
 453     $parser->ignore_errors(1);
 454     # Always provide bytes, not characters, to MIME objects
 455     $content = Encode::encode( 'UTF-8', $content );
 456     $self->{'MIMEObj'} = eval { $parser->parse_data( \$content ) };
 457     if ( my $error = $@ || $parser->last_error ) {
 458         $RT::Logger->error( "$error" );
 459         return ( 0, $error );
 460     }
 461
 462     # Unfold all headers
 463     $self->{'MIMEObj'}->head->unfold;
 464     $self->{'MIMEObj'}->head->modify(1);
 465
 466     return ( 1, $self->loc("Template parsed") );
 467
 468 }
 469
 470 # Perform Template substitutions on the template
 471
 472 sub _ParseContent {
 473     my $self = shift;
 474     my %args = (
 475         Argument       => undef,
 476         TicketObj      => undef,
 477         TransactionObj => undef,
 478         @_
 479     );
 480
 481     unless ( $self->CurrentUserCanRead() ) {
 482         return (undef, $self->loc("Permission Denied"));
 483     }
 484
 485     if ( $self->IsEmpty ) {
 486         return ( undef, $self->loc("Template is empty") );
 487     }
 488
 489     my $content = $self->SUPER::_Value('Content');
 490
 491     $args{'Ticket'} = delete $args{'TicketObj'} if $args{'TicketObj'};
 492     $args{'Transaction'} = delete $args{'TransactionObj'} if $args{'TransactionObj'};
 493     $args{'Requestor'} = eval { $args{'Ticket'}->Requestors->UserMembersObj->First->Name }
 494         if $args{'Ticket'};
 495     $args{'rtname'}    = RT->Config->Get('rtname');
 496     if ( $args{'Ticket'} ) {
 497         my $t = $args{'Ticket'}; # avoid memory leak
 498         $args{'loc'} = sub { $t->loc(@_) };
 499     } else {
 500         $args{'loc'} = sub { $self->loc(@_) };
 501     }
 502
 503     if ($self->Type eq 'Perl') {
 504         return $self->_ParseContentPerl(
 505             Content      => $content,
 506             TemplateArgs => \%args,
 507         );
 508     }
 509     else {
 510         return $self->_ParseContentSimple(
 511             Content      => $content,
 512             TemplateArgs => \%args,
 513         );
 514     }
 515 }
 516
 517 # uses Text::Template for Perl templates
 518 sub _ParseContentPerl {
 519     my $self = shift;
 520     my %args = (
 521         Content      => undef,
 522         TemplateArgs => {},
 523         @_,
 524     );
 525
 526     foreach my $key ( keys %{ $args{TemplateArgs} } ) {
 527         my $val = $args{TemplateArgs}{ $key };
 528         next unless ref $val;
 529         next if ref($val) =~ /^(ARRAY|HASH|SCALAR|CODE)$/;
 530         $args{TemplateArgs}{ $key } = \$val;
 531     }
 532
 533     my $template = Text::Template->new(
 534         TYPE   => 'STRING',
 535         SOURCE => $args{Content},
 536     );
 537     my ($ok) = $template->compile;
 538     unless ($ok) {
 539         $RT::Logger->error("Template parsing error in @{[$self->Name]} (#@{[$self->id]}): $Text::Template::ERROR");
 540         return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) );
 541     }
 542
 543     my $is_broken = 0;
 544     my $retval = $template->fill_in(
 545         HASH => $args{TemplateArgs},
 546         BROKEN => sub {
 547             my (%args) = @_;
 548             $RT::Logger->error("Template parsing error: $args{error}")
 549                 unless $args{error} =~ /^Died at /; # ignore intentional die()
 550             $is_broken++;
 551             return undef;
 552         },
 553     );
 554     return ( undef, $self->loc('Template parsing error') ) if $is_broken;
 555
 556     return ($retval);
 557 }
 558
 559 sub _ParseContentSimple {
 560     my $self = shift;
 561     my %args = (
 562         Content      => undef,
 563         TemplateArgs => {},
 564         @_,
 565     );
 566
 567     $self->_MassageSimpleTemplateArgs(%args);
 568
 569     my $template = Text::Template->new(
 570         TYPE   => 'STRING',
 571         SOURCE => $args{Content},
 572     );
 573     my ($ok) = $template->compile;
 574     return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) ) if !$ok;
 575
 576     # copied from Text::Template::fill_in and refactored to be simple variable
 577     # interpolation
 578     my $fi_r = '';
 579     foreach my $fi_item (@{$template->{SOURCE}}) {
 580         my ($fi_type, $fi_text, $fi_lineno) = @$fi_item;
 581         if ($fi_type eq 'TEXT') {
 582             $fi_r .= $fi_text;
 583         } elsif ($fi_type eq 'PROG') {
 584             my $fi_res;
 585             my $original_fi_text = $fi_text;
 586
 587             # strip surrounding whitespace for simpler regexes
 588             $fi_text =~ s/^\s+//;
 589             $fi_text =~ s/\s+$//;
 590
 591             # if the codeblock is a simple $Variable lookup, use the value from
 592             # the TemplateArgs hash...
 593             if (my ($var) = $fi_text =~ /^\$(\w+)$/) {
 594                 if (exists $args{TemplateArgs}{$var}) {
 595                     $fi_res = $args{TemplateArgs}{$var};
 596                 }
 597             }
 598
 599             # if there was no substitution then just reinsert the codeblock
 600             if (!defined $fi_res) {
 601                 $fi_res = "{$original_fi_text}";
 602             }
 603
 604             # If the value of the filled-in text really was undef,
 605             # change it to an explicit empty string to avoid undefined
 606             # value warnings later.
 607             $fi_res = '' unless defined $fi_res;
 608
 609             $fi_r .= $fi_res;
 610         }
 611     }
 612
 613     return $fi_r;
 614 }
 615
 616 sub _MassageSimpleTemplateArgs {
 617     my $self = shift;
 618     my %args = (
 619         TemplateArgs => {},
 620         @_,
 621     );
 622
 623     my $template_args = $args{TemplateArgs};
 624
 625     if (my $ticket = $template_args->{Ticket}) {
 626         for my $column (qw/Id Subject Type InitialPriority FinalPriority Priority TimeEstimated TimeWorked Status TimeLeft Told Starts Started Due Resolved RequestorAddresses AdminCcAddresses CcAddresses/) {
 627             $template_args->{"Ticket".$column} = $ticket->$column;
 628         }
 629
 630         $template_args->{"TicketQueueId"}   = $ticket->Queue;
 631         $template_args->{"TicketQueueName"} = $ticket->QueueObj->Name;
 632
 633         $template_args->{"TicketOwnerId"}    = $ticket->Owner;
 634         $template_args->{"TicketOwnerName"}  = $ticket->OwnerObj->Name;
 635         $template_args->{"TicketOwnerEmailAddress"} = $ticket->OwnerObj->EmailAddress;
 636
 637         my $cfs = $ticket->CustomFields;
 638         while (my $cf = $cfs->Next) {
 639             my $simple = $cf->Name;
 640             $simple =~ s/\W//g;
 641             $template_args->{"TicketCF" . $simple}
 642                 = $ticket->CustomFieldValuesAsString($cf->Name);
 643         }
 644     }
 645
 646     if (my $txn = $template_args->{Transaction}) {
 647         for my $column (qw/Id TimeTaken Type Field OldValue NewValue Data Content Subject Description BriefDescription/) {
 648             $template_args->{"Transaction".$column} = $txn->$column;
 649         }
 650
 651         my $cfs = $txn->CustomFields;
 652         while (my $cf = $cfs->Next) {
 653             my $simple = $cf->Name;
 654             $simple =~ s/\W//g;
 655             $template_args->{"TransactionCF" . $simple}
 656                 = $txn->CustomFieldValuesAsString($cf->Name);
 657         }
 658     }
 659 }
 660
 661 sub _DowngradeFromHTML {
 662     my $self = shift;
 663     my $orig_entity = $self->MIMEObj;
 664
 665     my $new_entity = $orig_entity->dup; # this will fail badly if we go away from InCore parsing
 666     $new_entity->head->mime_attr( "Content-Type" => 'text/plain' );
 667     $new_entity->head->mime_attr( "Content-Type.charset" => 'utf-8' );
 668
 669     $orig_entity->head->mime_attr( "Content-Type" => 'text/html' );
 670     $orig_entity->head->mime_attr( "Content-Type.charset" => 'utf-8' );
 671
 672     my $body = $new_entity->bodyhandle->as_string;
 673     $body = Encode::decode( "UTF-8", $body );
 674     my $html = RT::Interface::Email::ConvertHTMLToText( $body );
 675     $html = Encode::encode( "UTF-8", $html );
 676     return unless defined $html;
 677
 678     $new_entity->bodyhandle(MIME::Body::InCore->new( \$html ));
 679
 680     $orig_entity->make_multipart('alternative', Force => 1);
 681     $orig_entity->add_part($new_entity, 0); # plain comes before html
 682     $self->{MIMEObj} = $orig_entity;
 683
 684     return;
 685 }
 686
 687 =head2 CurrentUserHasQueueRight
 688
 689 Helper function to call the template's queue's CurrentUserHasQueueRight with the passed in args.
 690
 691 =cut
 692
 693 sub CurrentUserHasQueueRight {
 694     my $self = shift;
 695     return ( $self->QueueObj->CurrentUserHasRight(@_) );
 696 }
 697
 698 =head2 SetQueue
 699
 700 Changing queue is not implemented.
 701
 702 =cut
 703
 704 sub SetQueue {
 705     my $self = shift;
 706     return ( undef, $self->loc('Changing queue is not implemented') );
 707 }
 708
 709 =head2 SetName
 710
 711 Change name of the template.
 712
 713 =cut
 714
 715 sub SetName {
 716     my $self = shift;
 717     my $value = shift;
 718
 719     return ( undef, $self->loc('Name is required') )
 720         unless $value;
 721
 722     return $self->_Set( Field => 'Name', Value => $value )
 723         if lc($self->Name) eq lc($value);
 724
 725     my $tmp = $self->new( RT->SystemUser );
 726     $tmp->LoadByCols( Name => $value, Queue => $self->Queue );
 727     return ( undef, $self->loc('A Template with that name already exists') )
 728         if $tmp->id;
 729
 730     return $self->_Set( Field => 'Name', Value => $value );
 731 }
 732
 733 =head2 SetType
 734
 735 If setting Type to Perl, require the ExecuteCode right.
 736
 737 =cut
 738
 739 sub SetType {
 740     my $self    = shift;
 741     my $NewType = shift;
 742
 743     if ($NewType eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) {
 744         return ( undef, $self->loc('Permission Denied') );
 745     }
 746
 747     return $self->_Set( Field => 'Type', Value => $NewType );
 748 }
 749
 750 =head2 SetContent
 751
 752 If changing content and the type is Perl, require the ExecuteCode right.
 753
 754 =cut
 755
 756 sub SetContent {
 757     my $self       = shift;
 758     my $NewContent = shift;
 759
 760     if ($self->Type eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) {
 761         return ( undef, $self->loc('Permission Denied') );
 762     }
 763
 764     return $self->_Set( Field => 'Content', Value => $NewContent );
 765 }
 766
 767 sub _UpdateAttributes {
 768     my $self = shift;
 769     my %args = (
 770         NewValues => {},
 771         @_,
 772     );
 773
 774     my $type = $args{NewValues}{Type} || $self->Type;
 775
 776     # forbid updating content when the (possibly new) value of Type is Perl
 777     if ($type eq 'Perl' && exists $args{NewValues}{Content}) {
 778         if (!$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) {
 779             return $self->loc('Permission Denied');
 780         }
 781     }
 782
 783     return $self->SUPER::_UpdateAttributes(%args);
 784 }
 785
 786 =head2 CompileCheck
 787
 788 If the template's Type is Perl, then compile check all the codeblocks to see if
 789 they are syntactically valid. We eval them in a codeblock to avoid actually
 790 executing the code.
 791
 792 Returns an (ok, message) pair.
 793
 794 =cut
 795
 796 sub CompileCheck {
 797     my $self = shift;
 798
 799     return (1, $self->loc("Template does not include Perl code"))
 800         unless $self->Type eq 'Perl';
 801
 802     my $content = $self->Content;
 803     $content = '' if !defined($content);
 804
 805     my $template = Text::Template->new(
 806         TYPE   => 'STRING',
 807         SOURCE => $content,
 808     );
 809     my ($ok) = $template->compile;
 810     return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) ) if !$ok;
 811
 812     # copied from Text::Template::fill_in and refactored to be compile checks
 813     foreach my $fi_item (@{$template->{SOURCE}}) {
 814         my ($fi_type, $fi_text, $fi_lineno) = @$fi_item;
 815         next unless $fi_type eq 'PROG';
 816
 817         do {
 818             no strict 'vars';
 819             eval "sub { $fi_text }";
 820         };
 821         next if !$@;
 822
 823         my $error = $@;
 824
 825         # provide a (hopefully) useful line number for the error, but clean up
 826         # all the other extraneous garbage
 827         $error =~ s/\(eval \d+\) line (\d+).*/"template line " . ($1+$fi_lineno-1)/es;
 828
 829         return (0, $self->loc("Couldn't compile template codeblock '[_1]': [_2]", $fi_text, $error));
 830     }
 831
 832     return (1, $self->loc("Template compiles"));
 833 }
 834
 835 =head2 CurrentUserCanRead
 836
 837 =cut
 838
 839 sub CurrentUserCanRead {
 840     my $self =shift;
 841
 842     if ($self->__Value('Queue')) {
 843         my $queue = RT::Queue->new( RT->SystemUser );
 844         $queue->Load( $self->__Value('Queue'));
 845         return 1 if $self->CurrentUser->HasRight( Right => 'ShowTemplate', Object => $queue );
 846     } else {
 847         return 1 if $self->CurrentUser->HasRight( Right => 'ShowGlobalTemplates', Object => $RT::System );
 848         return 1 if $self->CurrentUser->HasRight( Right => 'ShowTemplate',        Object => $RT::System );
 849     }
 850
 851     return;
 852 }
 853
 854 1;
 855
 856 sub Table {'Templates'}
 857
 858
 859
 860
 861
 862
 863 =head2 id
 864
 865 Returns the current value of id.
 866 (In the database, id is stored as int(11).)
 867
 868
 869 =cut
 870
 871
 872 =head2 Queue
 873
 874 Returns the current value of Queue.
 875 (In the database, Queue is stored as int(11).)
 876
 877
 878
 879 =head2 SetQueue VALUE
 880
 881
 882 Set Queue to VALUE.
 883 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 884 (In the database, Queue will be stored as a int(11).)
 885
 886
 887 =cut
 888
 889
 890 =head2 QueueObj
 891
 892 Returns the Queue Object which has the id returned by Queue
 893
 894
 895 =cut
 896
 897 sub QueueObj {
 898     my $self = shift;
 899     my $Queue =  RT::Queue->new($self->CurrentUser);
 900     $Queue->Load($self->__Value('Queue'));
 901     return($Queue);
 902 }
 903
 904 =head2 Name
 905
 906 Returns the current value of Name.
 907 (In the database, Name is stored as varchar(200).)
 908
 909
 910
 911 =head2 SetName VALUE
 912
 913
 914 Set Name to VALUE.
 915 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 916 (In the database, Name will be stored as a varchar(200).)
 917
 918
 919 =cut
 920
 921
 922 =head2 Description
 923
 924 Returns the current value of Description.
 925 (In the database, Description is stored as varchar(255).)
 926
 927
 928
 929 =head2 SetDescription VALUE
 930
 931
 932 Set Description to VALUE.
 933 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 934 (In the database, Description will be stored as a varchar(255).)
 935
 936
 937 =cut
 938
 939
 940 =head2 Type
 941
 942 Returns the current value of Type.
 943 (In the database, Type is stored as varchar(16).)
 944
 945
 946
 947 =head2 SetType VALUE
 948
 949
 950 Set Type to VALUE.
 951 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 952 (In the database, Type will be stored as a varchar(16).)
 953
 954
 955 =cut
 956
 957
 958 =head2 Content
 959
 960 Returns the current value of Content.
 961 (In the database, Content is stored as text.)
 962
 963
 964
 965 =head2 SetContent VALUE
 966
 967
 968 Set Content to VALUE.
 969 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 970 (In the database, Content will be stored as a text.)
 971
 972
 973 =cut
 974
 975
 976 =head2 LastUpdated
 977
 978 Returns the current value of LastUpdated.
 979 (In the database, LastUpdated is stored as datetime.)
 980
 981
 982 =cut
 983
 984
 985 =head2 LastUpdatedBy
 986
 987 Returns the current value of LastUpdatedBy.
 988 (In the database, LastUpdatedBy is stored as int(11).)
 989
 990
 991 =cut
 992
 993
 994 =head2 Creator
 995
 996 Returns the current value of Creator.
 997 (In the database, Creator is stored as int(11).)
 998
 999
1000 =cut
1001
1002
1003 =head2 Created
1004
1005 Returns the current value of Created.
1006 (In the database, Created is stored as datetime.)
1007
1008
1009 =cut
1010
1011
1012
1013 sub _CoreAccessible {
1014     {
1015
1016         id =>
1017                 {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
1018         Queue =>
1019                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1020         Name =>
1021                 {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
1022         Description =>
1023                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1024         Type =>
1025                 {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
1026         Content =>
1027                 {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
1028         LastUpdated =>
1029                 {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
1030         LastUpdatedBy =>
1031                 {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1032         Creator =>
1033                 {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1034         Created =>
1035                 {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
1036
1037  }
1038 };
1039
1040 sub FindDependencies {
1041     my $self = shift;
1042     my ($walker, $deps) = @_;
1043
1044     $self->SUPER::FindDependencies($walker, $deps);
1045
1046     $deps->Add( out => $self->QueueObj ) if $self->QueueObj->Id;
1047 }
1048
1049 sub __DependsOn {
1050     my $self = shift;
1051     my %args = (
1052         Shredder => undef,
1053         Dependencies => undef,
1054         @_,
1055     );
1056     my $deps = $args{'Dependencies'};
1057     my $list = [];
1058
1059 # Scrips
1060     push( @$list, $self->UsedBy );
1061
1062     $deps->_PushDependencies(
1063         BaseObject => $self,
1064         Flags => RT::Shredder::Constants::DEPENDS_ON,
1065         TargetObjects => $list,
1066         Shredder => $args{'Shredder'},
1067     );
1068
1069     return $self->SUPER::__DependsOn( %args );
1070 }
1071
1072 sub PreInflate {
1073     my $class = shift;
1074     my ($importer, $uid, $data) = @_;
1075
1076     $class->SUPER::PreInflate( $importer, $uid, $data );
1077
1078     my $obj = RT::Template->new( RT->SystemUser );
1079     if ($data->{Queue} == 0) {
1080         $obj->LoadGlobalTemplate( $data->{Name} );
1081     } else {
1082         $obj->LoadQueueTemplate( Queue => $data->{Queue}, Name => $data->{Name} );
1083     }
1084
1085     if ($obj->Id) {
1086         $importer->Resolve( $uid => ref($obj) => $obj->Id );
1087         return;
1088     }
1089
1090     return 1;
1091 }
1092
1093 RT::Base->_ImportOverlays();
1094
1095 1;