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