Master to 4.2.8
[usit-rt.git] / lib / RT / Template.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2014 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     # We need to untaint the content of the template, since we'll be working
491     # with it
492     $content =~ s/^(.*)$/$1/;
493
494     $args{'Ticket'} = delete $args{'TicketObj'} if $args{'TicketObj'};
495     $args{'Transaction'} = delete $args{'TransactionObj'} if $args{'TransactionObj'};
496     $args{'Requestor'} = eval { $args{'Ticket'}->Requestors->UserMembersObj->First->Name }
497         if $args{'Ticket'};
498     $args{'rtname'}    = RT->Config->Get('rtname');
499     if ( $args{'Ticket'} ) {
500         my $t = $args{'Ticket'}; # avoid memory leak
501         $args{'loc'} = sub { $t->loc(@_) };
502     } else {
503         $args{'loc'} = sub { $self->loc(@_) };
504     }
505
506     if ($self->Type eq 'Perl') {
507         return $self->_ParseContentPerl(
508             Content      => $content,
509             TemplateArgs => \%args,
510         );
511     }
512     else {
513         return $self->_ParseContentSimple(
514             Content      => $content,
515             TemplateArgs => \%args,
516         );
517     }
518 }
519
520 # uses Text::Template for Perl templates
521 sub _ParseContentPerl {
522     my $self = shift;
523     my %args = (
524         Content      => undef,
525         TemplateArgs => {},
526         @_,
527     );
528
529     foreach my $key ( keys %{ $args{TemplateArgs} } ) {
530         my $val = $args{TemplateArgs}{ $key };
531         next unless ref $val;
532         next if ref($val) =~ /^(ARRAY|HASH|SCALAR|CODE)$/;
533         $args{TemplateArgs}{ $key } = \$val;
534     }
535
536     my $template = Text::Template->new(
537         TYPE   => 'STRING',
538         SOURCE => $args{Content},
539     );
540     my ($ok) = $template->compile;
541     unless ($ok) {
542         $RT::Logger->error("Template parsing error in @{[$self->Name]} (#@{[$self->id]}): $Text::Template::ERROR");
543         return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) );
544     }
545
546     my $is_broken = 0;
547     my $retval = $template->fill_in(
548         HASH => $args{TemplateArgs},
549         BROKEN => sub {
550             my (%args) = @_;
551             $RT::Logger->error("Template parsing error: $args{error}")
552                 unless $args{error} =~ /^Died at /; # ignore intentional die()
553             $is_broken++;
554             return undef;
555         },
556     );
557     return ( undef, $self->loc('Template parsing error') ) if $is_broken;
558
559     return ($retval);
560 }
561
562 sub _ParseContentSimple {
563     my $self = shift;
564     my %args = (
565         Content      => undef,
566         TemplateArgs => {},
567         @_,
568     );
569
570     $self->_MassageSimpleTemplateArgs(%args);
571
572     my $template = Text::Template->new(
573         TYPE   => 'STRING',
574         SOURCE => $args{Content},
575     );
576     my ($ok) = $template->compile;
577     return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) ) if !$ok;
578
579     # copied from Text::Template::fill_in and refactored to be simple variable
580     # interpolation
581     my $fi_r = '';
582     foreach my $fi_item (@{$template->{SOURCE}}) {
583         my ($fi_type, $fi_text, $fi_lineno) = @$fi_item;
584         if ($fi_type eq 'TEXT') {
585             $fi_r .= $fi_text;
586         } elsif ($fi_type eq 'PROG') {
587             my $fi_res;
588             my $original_fi_text = $fi_text;
589
590             # strip surrounding whitespace for simpler regexes
591             $fi_text =~ s/^\s+//;
592             $fi_text =~ s/\s+$//;
593
594             # if the codeblock is a simple $Variable lookup, use the value from
595             # the TemplateArgs hash...
596             if (my ($var) = $fi_text =~ /^\$(\w+)$/) {
597                 if (exists $args{TemplateArgs}{$var}) {
598                     $fi_res = $args{TemplateArgs}{$var};
599                 }
600             }
601
602             # if there was no substitution then just reinsert the codeblock
603             if (!defined $fi_res) {
604                 $fi_res = "{$original_fi_text}";
605             }
606
607             # If the value of the filled-in text really was undef,
608             # change it to an explicit empty string to avoid undefined
609             # value warnings later.
610             $fi_res = '' unless defined $fi_res;
611
612             $fi_r .= $fi_res;
613         }
614     }
615
616     return $fi_r;
617 }
618
619 sub _MassageSimpleTemplateArgs {
620     my $self = shift;
621     my %args = (
622         TemplateArgs => {},
623         @_,
624     );
625
626     my $template_args = $args{TemplateArgs};
627
628     if (my $ticket = $template_args->{Ticket}) {
629         for my $column (qw/Id Subject Type InitialPriority FinalPriority Priority TimeEstimated TimeWorked Status TimeLeft Told Starts Started Due Resolved RequestorAddresses AdminCcAddresses CcAddresses/) {
630             $template_args->{"Ticket".$column} = $ticket->$column;
631         }
632
633         $template_args->{"TicketQueueId"}   = $ticket->Queue;
634         $template_args->{"TicketQueueName"} = $ticket->QueueObj->Name;
635
636         $template_args->{"TicketOwnerId"}    = $ticket->Owner;
637         $template_args->{"TicketOwnerName"}  = $ticket->OwnerObj->Name;
638         $template_args->{"TicketOwnerEmailAddress"} = $ticket->OwnerObj->EmailAddress;
639
640         my $cfs = $ticket->CustomFields;
641         while (my $cf = $cfs->Next) {
642             my $simple = $cf->Name;
643             $simple =~ s/\W//g;
644             $template_args->{"TicketCF" . $simple}
645                 = $ticket->CustomFieldValuesAsString($cf->Name);
646         }
647     }
648
649     if (my $txn = $template_args->{Transaction}) {
650         for my $column (qw/Id TimeTaken Type Field OldValue NewValue Data Content Subject Description BriefDescription/) {
651             $template_args->{"Transaction".$column} = $txn->$column;
652         }
653
654         my $cfs = $txn->CustomFields;
655         while (my $cf = $cfs->Next) {
656             my $simple = $cf->Name;
657             $simple =~ s/\W//g;
658             $template_args->{"TransactionCF" . $simple}
659                 = $txn->CustomFieldValuesAsString($cf->Name);
660         }
661     }
662 }
663
664 sub _DowngradeFromHTML {
665     my $self = shift;
666     my $orig_entity = $self->MIMEObj;
667
668     my $new_entity = $orig_entity->dup; # this will fail badly if we go away from InCore parsing
669     $new_entity->head->mime_attr( "Content-Type" => 'text/plain' );
670     $new_entity->head->mime_attr( "Content-Type.charset" => 'utf-8' );
671
672     $orig_entity->head->mime_attr( "Content-Type" => 'text/html' );
673     $orig_entity->head->mime_attr( "Content-Type.charset" => 'utf-8' );
674
675     my $body = $new_entity->bodyhandle->as_string;
676     $body = Encode::decode( "UTF-8", $body );
677     my $html = RT::Interface::Email::ConvertHTMLToText( $body );
678     $html = Encode::encode( "UTF-8", $html );
679     return unless defined $html;
680
681     $new_entity->bodyhandle(MIME::Body::InCore->new( \$html ));
682
683     $orig_entity->make_multipart('alternative', Force => 1);
684     $orig_entity->add_part($new_entity, 0); # plain comes before html
685     $self->{MIMEObj} = $orig_entity;
686
687     return;
688 }
689
690 =head2 CurrentUserHasQueueRight
691
692 Helper function to call the template's queue's CurrentUserHasQueueRight with the passed in args.
693
694 =cut
695
696 sub CurrentUserHasQueueRight {
697     my $self = shift;
698     return ( $self->QueueObj->CurrentUserHasRight(@_) );
699 }
700
701 =head2 SetQueue
702
703 Changing queue is not implemented.
704
705 =cut
706
707 sub SetQueue {
708     my $self = shift;
709     return ( undef, $self->loc('Changing queue is not implemented') );
710 }
711
712 =head2 SetName
713
714 Change name of the template.
715
716 =cut
717
718 sub SetName {
719     my $self = shift;
720     my $value = shift;
721
722     return ( undef, $self->loc('Name is required') )
723         unless $value;
724
725     return $self->_Set( Field => 'Name', Value => $value )
726         if lc($self->Name) eq lc($value);
727
728     my $tmp = $self->new( RT->SystemUser );
729     $tmp->LoadByCols( Name => $value, Queue => $self->Queue );
730     return ( undef, $self->loc('A Template with that name already exists') )
731         if $tmp->id;
732
733     return $self->_Set( Field => 'Name', Value => $value );
734 }
735
736 =head2 SetType
737
738 If setting Type to Perl, require the ExecuteCode right.
739
740 =cut
741
742 sub SetType {
743     my $self    = shift;
744     my $NewType = shift;
745
746     if ($NewType eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) {
747         return ( undef, $self->loc('Permission Denied') );
748     }
749
750     return $self->_Set( Field => 'Type', Value => $NewType );
751 }
752
753 =head2 SetContent
754
755 If changing content and the type is Perl, require the ExecuteCode right.
756
757 =cut
758
759 sub SetContent {
760     my $self       = shift;
761     my $NewContent = shift;
762
763     if ($self->Type eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) {
764         return ( undef, $self->loc('Permission Denied') );
765     }
766
767     return $self->_Set( Field => 'Content', Value => $NewContent );
768 }
769
770 sub _UpdateAttributes {
771     my $self = shift;
772     my %args = (
773         NewValues => {},
774         @_,
775     );
776
777     my $type = $args{NewValues}{Type} || $self->Type;
778
779     # forbid updating content when the (possibly new) value of Type is Perl
780     if ($type eq 'Perl' && exists $args{NewValues}{Content}) {
781         if (!$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) {
782             return $self->loc('Permission Denied');
783         }
784     }
785
786     return $self->SUPER::_UpdateAttributes(%args);
787 }
788
789 =head2 CompileCheck
790
791 If the template's Type is Perl, then compile check all the codeblocks to see if
792 they are syntactically valid. We eval them in a codeblock to avoid actually
793 executing the code.
794
795 Returns an (ok, message) pair.
796
797 =cut
798
799 sub CompileCheck {
800     my $self = shift;
801
802     return (1, $self->loc("Template does not include Perl code"))
803         unless $self->Type eq 'Perl';
804
805     my $content = $self->Content;
806     $content = '' if !defined($content);
807
808     my $template = Text::Template->new(
809         TYPE   => 'STRING',
810         SOURCE => $content,
811     );
812     my ($ok) = $template->compile;
813     return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) ) if !$ok;
814
815     # copied from Text::Template::fill_in and refactored to be compile checks
816     foreach my $fi_item (@{$template->{SOURCE}}) {
817         my ($fi_type, $fi_text, $fi_lineno) = @$fi_item;
818         next unless $fi_type eq 'PROG';
819
820         do {
821             no strict 'vars';
822             eval "sub { $fi_text }";
823         };
824         next if !$@;
825
826         my $error = $@;
827
828         # provide a (hopefully) useful line number for the error, but clean up
829         # all the other extraneous garbage
830         $error =~ s/\(eval \d+\) line (\d+).*/"template line " . ($1+$fi_lineno-1)/es;
831
832         return (0, $self->loc("Couldn't compile template codeblock '[_1]': [_2]", $fi_text, $error));
833     }
834
835     return (1, $self->loc("Template compiles"));
836 }
837
838 =head2 CurrentUserCanRead
839
840 =cut
841
842 sub CurrentUserCanRead {
843     my $self =shift;
844
845     return 1 if $self->CurrentUserHasQueueRight('ShowTemplate');
846
847     return $self->CurrentUser->HasRight( Right =>'ShowGlobalTemplates', Object => $RT::System )
848         if !$self->QueueObj->Id;
849
850     return;
851 }
852
853 1;
854
855 sub Table {'Templates'}
856
857
858
859
860
861
862 =head2 id
863
864 Returns the current value of id.
865 (In the database, id is stored as int(11).)
866
867
868 =cut
869
870
871 =head2 Queue
872
873 Returns the current value of Queue.
874 (In the database, Queue is stored as int(11).)
875
876
877
878 =head2 SetQueue VALUE
879
880
881 Set Queue to VALUE.
882 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
883 (In the database, Queue will be stored as a int(11).)
884
885
886 =cut
887
888
889 =head2 QueueObj
890
891 Returns the Queue Object which has the id returned by Queue
892
893
894 =cut
895
896 sub QueueObj {
897     my $self = shift;
898     my $Queue =  RT::Queue->new($self->CurrentUser);
899     $Queue->Load($self->__Value('Queue'));
900     return($Queue);
901 }
902
903 =head2 Name
904
905 Returns the current value of Name.
906 (In the database, Name is stored as varchar(200).)
907
908
909
910 =head2 SetName VALUE
911
912
913 Set Name to VALUE.
914 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
915 (In the database, Name will be stored as a varchar(200).)
916
917
918 =cut
919
920
921 =head2 Description
922
923 Returns the current value of Description.
924 (In the database, Description is stored as varchar(255).)
925
926
927
928 =head2 SetDescription VALUE
929
930
931 Set Description to VALUE.
932 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
933 (In the database, Description will be stored as a varchar(255).)
934
935
936 =cut
937
938
939 =head2 Type
940
941 Returns the current value of Type.
942 (In the database, Type is stored as varchar(16).)
943
944
945
946 =head2 SetType VALUE
947
948
949 Set Type to VALUE.
950 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
951 (In the database, Type will be stored as a varchar(16).)
952
953
954 =cut
955
956
957 =head2 Content
958
959 Returns the current value of Content.
960 (In the database, Content is stored as text.)
961
962
963
964 =head2 SetContent VALUE
965
966
967 Set Content to VALUE.
968 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
969 (In the database, Content will be stored as a text.)
970
971
972 =cut
973
974
975 =head2 LastUpdated
976
977 Returns the current value of LastUpdated.
978 (In the database, LastUpdated is stored as datetime.)
979
980
981 =cut
982
983
984 =head2 LastUpdatedBy
985
986 Returns the current value of LastUpdatedBy.
987 (In the database, LastUpdatedBy is stored as int(11).)
988
989
990 =cut
991
992
993 =head2 Creator
994
995 Returns the current value of Creator.
996 (In the database, Creator is stored as int(11).)
997
998
999 =cut
1000
1001
1002 =head2 Created
1003
1004 Returns the current value of Created.
1005 (In the database, Created is stored as datetime.)
1006
1007
1008 =cut
1009
1010
1011
1012 sub _CoreAccessible {
1013     {
1014
1015         id =>
1016                 {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
1017         Queue =>
1018                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1019         Name =>
1020                 {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
1021         Description =>
1022                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1023         Type =>
1024                 {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
1025         Content =>
1026                 {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
1027         LastUpdated =>
1028                 {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
1029         LastUpdatedBy =>
1030                 {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1031         Creator =>
1032                 {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1033         Created =>
1034                 {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
1035
1036  }
1037 };
1038
1039 sub FindDependencies {
1040     my $self = shift;
1041     my ($walker, $deps) = @_;
1042
1043     $self->SUPER::FindDependencies($walker, $deps);
1044
1045     $deps->Add( out => $self->QueueObj ) if $self->QueueObj->Id;
1046 }
1047
1048 sub PreInflate {
1049     my $class = shift;
1050     my ($importer, $uid, $data) = @_;
1051
1052     $class->SUPER::PreInflate( $importer, $uid, $data );
1053
1054     my $obj = RT::Template->new( RT->SystemUser );
1055     if ($data->{Queue} == 0) {
1056         $obj->LoadGlobalTemplate( $data->{Name} );
1057     } else {
1058         $obj->LoadQueueTemplate( Queue => $data->{Queue}, Name => $data->{Name} );
1059     }
1060
1061     if ($obj->Id) {
1062         $importer->Resolve( $uid => ref($obj) => $obj->Id );
1063         return;
1064     }
1065
1066     return 1;
1067 }
1068
1069 RT::Base->_ImportOverlays();
1070
1071 1;