Merge branch 'master' of git.uio.no:usit-rt
[usit-rt.git] / lib / RT / Template.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
84fb5b46
MKG
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
68package RT::Template;
69
70use strict;
71use warnings;
72
af59614d 73use base 'RT::Record';
84fb5b46 74
af59614d 75use RT::Queue;
84fb5b46
MKG
76
77use Text::Template;
78use MIME::Entity;
79use MIME::Parser;
80use Scalar::Util 'blessed';
81
82sub _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
99sub _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
134Takes the name of a table column. Returns its value as a string,
135if the user passes an ACL check, otherwise returns undef.
136
137=cut
138
139sub _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
151Load a template, either by number or by name.
152
153Note that loading templates by name using this method B<is
154ambiguous>. Several queues may have template with the same name
155and as well global template with the same name may exist.
af59614d 156Use L</LoadByName>, L</LoadGlobalTemplate> or L<LoadQueueTemplate> to get
84fb5b46
MKG
157precise result.
158
159=cut
160
161sub 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
af59614d
MKG
172=head2 LoadByName
173
174Takes Name and Queue arguments. Tries to load queue specific template
175first, then global. If Queue argument is omitted then global template
176is tried, not template with the name in any queue.
177
178=cut
179
180sub 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
84fb5b46
MKG
203=head2 LoadGlobalTemplate NAME
204
205Load the global template with the name NAME
206
207=cut
208
209sub 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
218Loads the Queue template named NAME for Queue QUEUE.
219
220Note that this method doesn't load a global template with the same name
af59614d 221if template in the queue doesn't exist. Use L</LoadByName>.
84fb5b46
MKG
222
223=cut
224
225sub 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
239Takes a paramhash of Content, Queue, Name and Description.
240Name should be a unique string identifying this Template.
241Description and Content should be the template's title and content.
242Queue should be 0 for a global template and the queue # for a queue-specific
243template.
244
245Returns the Template's id # if the create was successful. Returns undef for
246unknown database failure.
247
248=cut
249
250sub 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
af59614d
MKG
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
320f0092 291 my ( $result, $msg ) = $self->SUPER::Create(
84fb5b46
MKG
292 Content => $args{'Content'},
293 Queue => $args{'Queue'},
294 Description => $args{'Description'},
295 Name => $args{'Name'},
296 Type => $args{'Type'},
297 );
298
320f0092
MKG
299 if ( wantarray ) {
300 return ( $result, $msg );
301 } else {
302 return ( $result );
303 }
84fb5b46
MKG
304
305}
306
307=head2 Delete
308
309Delete this template.
310
311=cut
312
313sub Delete {
314 my $self = shift;
315
316 unless ( $self->CurrentUserHasQueueRight('ModifyTemplate') ) {
317 return ( 0, $self->loc('Permission Denied') );
318 }
319
af59614d
MKG
320 if ( !$self->IsOverride && $self->UsedBy->Count ) {
321 return ( 0, $self->loc('Template is in use') );
322 }
323
84fb5b46
MKG
324 return ( $self->SUPER::Delete(@_) );
325}
326
af59614d
MKG
327=head2 UsedBy
328
329Returns L<RT::Scrips> limitted to scrips that use this template. Takes
330into account that template can be overriden in a queue.
331
332=cut
333
334sub UsedBy {
335 my $self = shift;
336
337 my $scrips = RT::Scrips->new( $self->CurrentUser );
338 $scrips->LimitByTemplate( $self );
339 return $scrips;
340}
341
84fb5b46
MKG
342=head2 IsEmpty
343
344Returns true value if content of the template is empty, otherwise
345returns false.
346
347=cut
348
349sub IsEmpty {
350 my $self = shift;
351 my $content = $self->Content;
352 return 0 if defined $content && length $content;
353 return 1;
354}
355
af59614d
MKG
356=head2 IsOverride
357
358Returns true if it's queue specific template and there is global
359template with the same name.
360
361=cut
362
363sub 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
84fb5b46
MKG
373=head2 MIMEObj
374
375Returns L<MIME::Entity> object parsed using L</Parse> method. Returns
376undef if last call to L</Parse> failed or never be called.
377
c33a4027
MKG
378Note that content of the template is characters, but the contents of all
379L<MIME::Entity> objects (including the one returned by this function,
380are bytes in UTF-8.
84fb5b46
MKG
381
382=cut
383
384sub MIMEObj {
385 my $self = shift;
386 return ( $self->{'MIMEObj'} );
387}
388
389=head2 Parse
390
391This routine performs L<Text::Template> parsing on the template and then
392imports the results into a L<MIME::Entity> so we can really use it. Use
393L</MIMEObj> method to get the L<MIME::Entity> object.
394
395Takes a hash containing Argument, TicketObj, and TransactionObj and other
396arguments that will be available in the template's code. TicketObj and
397TransactionObj are not mandatory, but highly recommended.
398
399It returns a tuple of (val, message). If val is false, the message contains
400an error message.
401
402=cut
403
404sub Parse {
405 my $self = shift;
406 my ($rv, $msg);
407
408
5b0d0914 409 if (not $self->IsEmpty and $self->Content =~ m{^Content-Type:\s+text/html\b}im) {
84fb5b46
MKG
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
427sub _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);
c33a4027
MKG
454 # Always provide bytes, not characters, to MIME objects
455 $content = Encode::encode( 'UTF-8', $content );
84fb5b46
MKG
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;
dab09ea8 464 $self->{'MIMEObj'}->head->modify(1);
84fb5b46
MKG
465
466 return ( 1, $self->loc("Template parsed") );
467
468}
469
470# Perform Template substitutions on the template
471
472sub _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
521sub _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;
403d7b0b 532 next if ref($val) =~ /^(ARRAY|HASH|SCALAR|CODE)$/;
84fb5b46
MKG
533 $args{TemplateArgs}{ $key } = \$val;
534 }
535
536 my $template = Text::Template->new(
537 TYPE => 'STRING',
538 SOURCE => $args{Content},
539 );
c33a4027
MKG
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
84fb5b46
MKG
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
562sub _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
619sub _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) {
c33a4027
MKG
642 my $simple = $cf->Name;
643 $simple =~ s/\W//g;
644 $template_args->{"TicketCF" . $simple}
645 = $ticket->CustomFieldValuesAsString($cf->Name);
84fb5b46
MKG
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) {
c33a4027
MKG
656 my $simple = $cf->Name;
657 $simple =~ s/\W//g;
658 $template_args->{"TransactionCF" . $simple}
659 = $txn->CustomFieldValuesAsString($cf->Name);
84fb5b46
MKG
660 }
661 }
662}
663
664sub _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' );
84fb5b46 674
320f0092 675 my $body = $new_entity->bodyhandle->as_string;
c33a4027 676 $body = Encode::decode( "UTF-8", $body );
320f0092 677 my $html = RT::Interface::Email::ConvertHTMLToText( $body );
c33a4027 678 $html = Encode::encode( "UTF-8", $html );
320f0092 679 return unless defined $html;
84fb5b46 680
320f0092
MKG
681 $new_entity->bodyhandle(MIME::Body::InCore->new( \$html ));
682
683 $orig_entity->make_multipart('alternative', Force => 1);
84fb5b46
MKG
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
692Helper function to call the template's queue's CurrentUserHasQueueRight with the passed in args.
693
694=cut
695
696sub CurrentUserHasQueueRight {
697 my $self = shift;
698 return ( $self->QueueObj->CurrentUserHasRight(@_) );
699}
700
af59614d
MKG
701=head2 SetQueue
702
703Changing queue is not implemented.
704
705=cut
706
707sub SetQueue {
708 my $self = shift;
709 return ( undef, $self->loc('Changing queue is not implemented') );
710}
711
712=head2 SetName
713
714Change name of the template.
715
716=cut
717
718sub 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
84fb5b46
MKG
736=head2 SetType
737
738If setting Type to Perl, require the ExecuteCode right.
739
740=cut
741
742sub 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
755If changing content and the type is Perl, require the ExecuteCode right.
756
757=cut
758
759sub 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
770sub _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
791If the template's Type is Perl, then compile check all the codeblocks to see if
792they are syntactically valid. We eval them in a codeblock to avoid actually
793executing the code.
794
795Returns an (ok, message) pair.
796
797=cut
798
799sub 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
842sub 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
8531;
854
84fb5b46
MKG
855sub Table {'Templates'}
856
857
858
859
860
861
862=head2 id
863
864Returns 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
873Returns the current value of Queue.
874(In the database, Queue is stored as int(11).)
875
876
877
878=head2 SetQueue VALUE
879
880
881Set Queue to VALUE.
882Returns (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
891Returns the Queue Object which has the id returned by Queue
892
893
894=cut
895
896sub QueueObj {
af59614d
MKG
897 my $self = shift;
898 my $Queue = RT::Queue->new($self->CurrentUser);
899 $Queue->Load($self->__Value('Queue'));
900 return($Queue);
84fb5b46
MKG
901}
902
903=head2 Name
904
905Returns the current value of Name.
906(In the database, Name is stored as varchar(200).)
907
908
909
910=head2 SetName VALUE
911
912
913Set Name to VALUE.
914Returns (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
923Returns the current value of Description.
924(In the database, Description is stored as varchar(255).)
925
926
927
928=head2 SetDescription VALUE
929
930
931Set Description to VALUE.
932Returns (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
941Returns the current value of Type.
942(In the database, Type is stored as varchar(16).)
943
944
945
946=head2 SetType VALUE
947
948
949Set Type to VALUE.
950Returns (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
84fb5b46
MKG
957=head2 Content
958
959Returns the current value of Content.
960(In the database, Content is stored as text.)
961
962
963
964=head2 SetContent VALUE
965
966
967Set Content to VALUE.
968Returns (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
977Returns the current value of LastUpdated.
978(In the database, LastUpdated is stored as datetime.)
979
980
981=cut
982
983
984=head2 LastUpdatedBy
985
986Returns 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
995Returns 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
1004Returns the current value of Created.
1005(In the database, Created is stored as datetime.)
1006
1007
1008=cut
1009
1010
1011
1012sub _CoreAccessible {
1013 {
1014
1015 id =>
af59614d 1016 {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
84fb5b46 1017 Queue =>
af59614d 1018 {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
84fb5b46 1019 Name =>
af59614d 1020 {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''},
84fb5b46 1021 Description =>
af59614d 1022 {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
84fb5b46 1023 Type =>
af59614d 1024 {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''},
84fb5b46 1025 Content =>
af59614d 1026 {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''},
84fb5b46 1027 LastUpdated =>
af59614d 1028 {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
84fb5b46 1029 LastUpdatedBy =>
af59614d 1030 {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
84fb5b46 1031 Creator =>
af59614d 1032 {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
84fb5b46 1033 Created =>
af59614d 1034 {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
84fb5b46
MKG
1035
1036 }
1037};
1038
af59614d
MKG
1039sub 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
1048sub 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
84fb5b46
MKG
1069RT::Base->_ImportOverlays();
1070
10711;