]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
403d7b0b | 5 | # This software is Copyright (c) 1996-2013 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 | ||
68 | package RT::Template; | |
69 | ||
70 | use strict; | |
71 | use warnings; | |
72 | ||
73 | ||
74 | ||
75 | use Text::Template; | |
76 | use MIME::Entity; | |
77 | use MIME::Parser; | |
78 | use Scalar::Util 'blessed'; | |
79 | ||
80 | sub _Accessible { | |
81 | my $self = shift; | |
82 | my %Cols = ( | |
83 | id => 'read', | |
84 | Name => 'read/write', | |
85 | Description => 'read/write', | |
86 | Type => 'read/write', #Type is one of Perl or Simple | |
87 | Content => 'read/write', | |
88 | Queue => 'read/write', | |
89 | Creator => 'read/auto', | |
90 | Created => 'read/auto', | |
91 | LastUpdatedBy => 'read/auto', | |
92 | LastUpdated => 'read/auto' | |
93 | ); | |
94 | return $self->SUPER::_Accessible( @_, %Cols ); | |
95 | } | |
96 | ||
97 | sub _Set { | |
98 | my $self = shift; | |
99 | my %args = ( | |
100 | Field => undef, | |
101 | Value => undef, | |
102 | @_, | |
103 | ); | |
104 | ||
105 | unless ( $self->CurrentUserHasQueueRight('ModifyTemplate') ) { | |
106 | return ( 0, $self->loc('Permission Denied') ); | |
107 | } | |
108 | ||
109 | if (exists $args{Value}) { | |
110 | if ($args{Field} eq 'Queue') { | |
111 | if ($args{Value}) { | |
112 | # moving to another queue | |
113 | my $queue = RT::Queue->new( $self->CurrentUser ); | |
114 | $queue->Load($args{Value}); | |
115 | unless ($queue->Id and $queue->CurrentUserHasRight('ModifyTemplate')) { | |
116 | return ( 0, $self->loc('Permission Denied') ); | |
117 | } | |
118 | } else { | |
119 | # moving to global | |
120 | unless ($self->CurrentUser->HasRight( Object => RT->System, Right => 'ModifyTemplate' )) { | |
121 | return ( 0, $self->loc('Permission Denied') ); | |
122 | } | |
123 | } | |
124 | } | |
125 | } | |
126 | ||
127 | return $self->SUPER::_Set( @_ ); | |
128 | } | |
129 | ||
130 | =head2 _Value | |
131 | ||
132 | Takes the name of a table column. Returns its value as a string, | |
133 | if the user passes an ACL check, otherwise returns undef. | |
134 | ||
135 | =cut | |
136 | ||
137 | sub _Value { | |
138 | my $self = shift; | |
139 | ||
140 | unless ( $self->CurrentUserCanRead() ) { | |
141 | return undef; | |
142 | } | |
143 | return $self->__Value( @_ ); | |
144 | ||
145 | } | |
146 | ||
147 | =head2 Load <identifier> | |
148 | ||
149 | Load a template, either by number or by name. | |
150 | ||
151 | Note that loading templates by name using this method B<is | |
152 | ambiguous>. Several queues may have template with the same name | |
153 | and as well global template with the same name may exist. | |
154 | Use L</LoadGlobalTemplate> and/or L<LoadQueueTemplate> to get | |
155 | precise result. | |
156 | ||
157 | =cut | |
158 | ||
159 | sub Load { | |
160 | my $self = shift; | |
161 | my $identifier = shift; | |
162 | return undef unless $identifier; | |
163 | ||
164 | if ( $identifier =~ /\D/ ) { | |
165 | return $self->LoadByCol( 'Name', $identifier ); | |
166 | } | |
167 | return $self->LoadById( $identifier ); | |
168 | } | |
169 | ||
170 | =head2 LoadGlobalTemplate NAME | |
171 | ||
172 | Load the global template with the name NAME | |
173 | ||
174 | =cut | |
175 | ||
176 | sub LoadGlobalTemplate { | |
177 | my $self = shift; | |
178 | my $name = shift; | |
179 | ||
180 | return ( $self->LoadQueueTemplate( Queue => 0, Name => $name ) ); | |
181 | } | |
182 | ||
183 | =head2 LoadQueueTemplate (Queue => QUEUEID, Name => NAME) | |
184 | ||
185 | Loads the Queue template named NAME for Queue QUEUE. | |
186 | ||
187 | Note that this method doesn't load a global template with the same name | |
188 | if template in the queue doesn't exist. THe following code can be used: | |
189 | ||
190 | $template->LoadQueueTemplate( Queue => $queue_id, Name => $template_name ); | |
191 | unless ( $template->id ) { | |
192 | $template->LoadGlobalTemplate( $template_name ); | |
193 | unless ( $template->id ) { | |
194 | # no template | |
195 | ... | |
196 | } | |
197 | } | |
198 | # ok, template either queue's or global | |
199 | ... | |
200 | ||
201 | =cut | |
202 | ||
203 | sub LoadQueueTemplate { | |
204 | my $self = shift; | |
205 | my %args = ( | |
206 | Queue => undef, | |
207 | Name => undef, | |
208 | @_ | |
209 | ); | |
210 | ||
211 | return ( $self->LoadByCols( Name => $args{'Name'}, Queue => $args{'Queue'} ) ); | |
212 | ||
213 | } | |
214 | ||
215 | =head2 Create | |
216 | ||
217 | Takes a paramhash of Content, Queue, Name and Description. | |
218 | Name should be a unique string identifying this Template. | |
219 | Description and Content should be the template's title and content. | |
220 | Queue should be 0 for a global template and the queue # for a queue-specific | |
221 | template. | |
222 | ||
223 | Returns the Template's id # if the create was successful. Returns undef for | |
224 | unknown database failure. | |
225 | ||
226 | =cut | |
227 | ||
228 | sub Create { | |
229 | my $self = shift; | |
230 | my %args = ( | |
231 | Content => undef, | |
232 | Queue => 0, | |
233 | Description => '[no description]', | |
234 | Type => 'Perl', | |
235 | Name => undef, | |
236 | @_ | |
237 | ); | |
238 | ||
239 | if ( $args{Type} eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System) ) { | |
240 | return ( undef, $self->loc('Permission Denied') ); | |
241 | } | |
242 | ||
243 | unless ( $args{'Queue'} ) { | |
244 | unless ( $self->CurrentUser->HasRight(Right =>'ModifyTemplate', Object => $RT::System) ) { | |
245 | return ( undef, $self->loc('Permission Denied') ); | |
246 | } | |
247 | $args{'Queue'} = 0; | |
248 | } | |
249 | else { | |
250 | my $QueueObj = RT::Queue->new( $self->CurrentUser ); | |
251 | $QueueObj->Load( $args{'Queue'} ) || return ( undef, $self->loc('Invalid queue') ); | |
252 | ||
253 | unless ( $QueueObj->CurrentUserHasRight('ModifyTemplate') ) { | |
254 | return ( undef, $self->loc('Permission Denied') ); | |
255 | } | |
256 | $args{'Queue'} = $QueueObj->Id; | |
257 | } | |
258 | ||
259 | my $result = $self->SUPER::Create( | |
260 | Content => $args{'Content'}, | |
261 | Queue => $args{'Queue'}, | |
262 | Description => $args{'Description'}, | |
263 | Name => $args{'Name'}, | |
264 | Type => $args{'Type'}, | |
265 | ); | |
266 | ||
267 | return ($result); | |
268 | ||
269 | } | |
270 | ||
271 | =head2 Delete | |
272 | ||
273 | Delete this template. | |
274 | ||
275 | =cut | |
276 | ||
277 | sub Delete { | |
278 | my $self = shift; | |
279 | ||
280 | unless ( $self->CurrentUserHasQueueRight('ModifyTemplate') ) { | |
281 | return ( 0, $self->loc('Permission Denied') ); | |
282 | } | |
283 | ||
284 | return ( $self->SUPER::Delete(@_) ); | |
285 | } | |
286 | ||
287 | =head2 IsEmpty | |
288 | ||
289 | Returns true value if content of the template is empty, otherwise | |
290 | returns false. | |
291 | ||
292 | =cut | |
293 | ||
294 | sub IsEmpty { | |
295 | my $self = shift; | |
296 | my $content = $self->Content; | |
297 | return 0 if defined $content && length $content; | |
298 | return 1; | |
299 | } | |
300 | ||
301 | =head2 MIMEObj | |
302 | ||
303 | Returns L<MIME::Entity> object parsed using L</Parse> method. Returns | |
304 | undef if last call to L</Parse> failed or never be called. | |
305 | ||
306 | Note that content of the template is UTF-8, but L<MIME::Parser> is not | |
307 | good at handling it and all data of the entity should be treated as | |
308 | octets and converted to perl strings using Encode::decode_utf8 or | |
309 | something else. | |
310 | ||
311 | =cut | |
312 | ||
313 | sub MIMEObj { | |
314 | my $self = shift; | |
315 | return ( $self->{'MIMEObj'} ); | |
316 | } | |
317 | ||
318 | =head2 Parse | |
319 | ||
320 | This routine performs L<Text::Template> parsing on the template and then | |
321 | imports the results into a L<MIME::Entity> so we can really use it. Use | |
322 | L</MIMEObj> method to get the L<MIME::Entity> object. | |
323 | ||
324 | Takes a hash containing Argument, TicketObj, and TransactionObj and other | |
325 | arguments that will be available in the template's code. TicketObj and | |
326 | TransactionObj are not mandatory, but highly recommended. | |
327 | ||
328 | It returns a tuple of (val, message). If val is false, the message contains | |
329 | an error message. | |
330 | ||
331 | =cut | |
332 | ||
333 | sub Parse { | |
334 | my $self = shift; | |
335 | my ($rv, $msg); | |
336 | ||
337 | ||
338 | if ($self->Content =~ m{^Content-Type:\s+text/html\b}im) { | |
339 | local $RT::Transaction::PreferredContentType = 'text/html'; | |
340 | ($rv, $msg) = $self->_Parse(@_); | |
341 | } | |
342 | else { | |
343 | ($rv, $msg) = $self->_Parse(@_); | |
344 | } | |
345 | ||
346 | return ($rv, $msg) unless $rv; | |
347 | ||
348 | my $mime_type = $self->MIMEObj->mime_type; | |
349 | if (defined $mime_type and $mime_type eq 'text/html') { | |
350 | $self->_DowngradeFromHTML(@_); | |
351 | } | |
352 | ||
353 | return ($rv, $msg); | |
354 | } | |
355 | ||
356 | sub _Parse { | |
357 | my $self = shift; | |
358 | ||
359 | # clear prev MIME object | |
360 | $self->{'MIMEObj'} = undef; | |
361 | ||
362 | #We're passing in whatever we were passed. it's destined for _ParseContent | |
363 | my ($content, $msg) = $self->_ParseContent(@_); | |
364 | return ( 0, $msg ) unless defined $content && length $content; | |
365 | ||
366 | if ( $content =~ /^\S/s && $content !~ /^\S+:/ ) { | |
367 | $RT::Logger->error( | |
368 | "Template #". $self->id ." has leading line that doesn't" | |
369 | ." look like header field, if you don't want to override" | |
370 | ." any headers and don't want to see this error message" | |
371 | ." then leave first line of the template empty" | |
372 | ); | |
373 | $content = "\n".$content; | |
374 | } | |
375 | ||
376 | my $parser = MIME::Parser->new(); | |
377 | $parser->output_to_core(1); | |
378 | $parser->tmp_to_core(1); | |
379 | $parser->use_inner_files(1); | |
380 | ||
381 | ### Should we forgive normally-fatal errors? | |
382 | $parser->ignore_errors(1); | |
383 | # MIME::Parser doesn't play well with perl strings | |
384 | utf8::encode($content); | |
385 | $self->{'MIMEObj'} = eval { $parser->parse_data( \$content ) }; | |
386 | if ( my $error = $@ || $parser->last_error ) { | |
387 | $RT::Logger->error( "$error" ); | |
388 | return ( 0, $error ); | |
389 | } | |
390 | ||
391 | # Unfold all headers | |
392 | $self->{'MIMEObj'}->head->unfold; | |
dab09ea8 | 393 | $self->{'MIMEObj'}->head->modify(1); |
84fb5b46 MKG |
394 | |
395 | return ( 1, $self->loc("Template parsed") ); | |
396 | ||
397 | } | |
398 | ||
399 | # Perform Template substitutions on the template | |
400 | ||
401 | sub _ParseContent { | |
402 | my $self = shift; | |
403 | my %args = ( | |
404 | Argument => undef, | |
405 | TicketObj => undef, | |
406 | TransactionObj => undef, | |
407 | @_ | |
408 | ); | |
409 | ||
410 | unless ( $self->CurrentUserCanRead() ) { | |
411 | return (undef, $self->loc("Permission Denied")); | |
412 | } | |
413 | ||
414 | if ( $self->IsEmpty ) { | |
415 | return ( undef, $self->loc("Template is empty") ); | |
416 | } | |
417 | ||
418 | my $content = $self->SUPER::_Value('Content'); | |
419 | # We need to untaint the content of the template, since we'll be working | |
420 | # with it | |
421 | $content =~ s/^(.*)$/$1/; | |
422 | ||
423 | $args{'Ticket'} = delete $args{'TicketObj'} if $args{'TicketObj'}; | |
424 | $args{'Transaction'} = delete $args{'TransactionObj'} if $args{'TransactionObj'}; | |
425 | $args{'Requestor'} = eval { $args{'Ticket'}->Requestors->UserMembersObj->First->Name } | |
426 | if $args{'Ticket'}; | |
427 | $args{'rtname'} = RT->Config->Get('rtname'); | |
428 | if ( $args{'Ticket'} ) { | |
429 | my $t = $args{'Ticket'}; # avoid memory leak | |
430 | $args{'loc'} = sub { $t->loc(@_) }; | |
431 | } else { | |
432 | $args{'loc'} = sub { $self->loc(@_) }; | |
433 | } | |
434 | ||
435 | if ($self->Type eq 'Perl') { | |
436 | return $self->_ParseContentPerl( | |
437 | Content => $content, | |
438 | TemplateArgs => \%args, | |
439 | ); | |
440 | } | |
441 | else { | |
442 | return $self->_ParseContentSimple( | |
443 | Content => $content, | |
444 | TemplateArgs => \%args, | |
445 | ); | |
446 | } | |
447 | } | |
448 | ||
449 | # uses Text::Template for Perl templates | |
450 | sub _ParseContentPerl { | |
451 | my $self = shift; | |
452 | my %args = ( | |
453 | Content => undef, | |
454 | TemplateArgs => {}, | |
455 | @_, | |
456 | ); | |
457 | ||
458 | foreach my $key ( keys %{ $args{TemplateArgs} } ) { | |
459 | my $val = $args{TemplateArgs}{ $key }; | |
460 | next unless ref $val; | |
403d7b0b | 461 | next if ref($val) =~ /^(ARRAY|HASH|SCALAR|CODE)$/; |
84fb5b46 MKG |
462 | $args{TemplateArgs}{ $key } = \$val; |
463 | } | |
464 | ||
465 | my $template = Text::Template->new( | |
466 | TYPE => 'STRING', | |
467 | SOURCE => $args{Content}, | |
468 | ); | |
469 | my $is_broken = 0; | |
470 | my $retval = $template->fill_in( | |
471 | HASH => $args{TemplateArgs}, | |
472 | BROKEN => sub { | |
473 | my (%args) = @_; | |
474 | $RT::Logger->error("Template parsing error: $args{error}") | |
475 | unless $args{error} =~ /^Died at /; # ignore intentional die() | |
476 | $is_broken++; | |
477 | return undef; | |
478 | }, | |
479 | ); | |
480 | return ( undef, $self->loc('Template parsing error') ) if $is_broken; | |
481 | ||
482 | return ($retval); | |
483 | } | |
484 | ||
485 | sub _ParseContentSimple { | |
486 | my $self = shift; | |
487 | my %args = ( | |
488 | Content => undef, | |
489 | TemplateArgs => {}, | |
490 | @_, | |
491 | ); | |
492 | ||
493 | $self->_MassageSimpleTemplateArgs(%args); | |
494 | ||
495 | my $template = Text::Template->new( | |
496 | TYPE => 'STRING', | |
497 | SOURCE => $args{Content}, | |
498 | ); | |
499 | my ($ok) = $template->compile; | |
500 | return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) ) if !$ok; | |
501 | ||
502 | # copied from Text::Template::fill_in and refactored to be simple variable | |
503 | # interpolation | |
504 | my $fi_r = ''; | |
505 | foreach my $fi_item (@{$template->{SOURCE}}) { | |
506 | my ($fi_type, $fi_text, $fi_lineno) = @$fi_item; | |
507 | if ($fi_type eq 'TEXT') { | |
508 | $fi_r .= $fi_text; | |
509 | } elsif ($fi_type eq 'PROG') { | |
510 | my $fi_res; | |
511 | my $original_fi_text = $fi_text; | |
512 | ||
513 | # strip surrounding whitespace for simpler regexes | |
514 | $fi_text =~ s/^\s+//; | |
515 | $fi_text =~ s/\s+$//; | |
516 | ||
517 | # if the codeblock is a simple $Variable lookup, use the value from | |
518 | # the TemplateArgs hash... | |
519 | if (my ($var) = $fi_text =~ /^\$(\w+)$/) { | |
520 | if (exists $args{TemplateArgs}{$var}) { | |
521 | $fi_res = $args{TemplateArgs}{$var}; | |
522 | } | |
523 | } | |
524 | ||
525 | # if there was no substitution then just reinsert the codeblock | |
526 | if (!defined $fi_res) { | |
527 | $fi_res = "{$original_fi_text}"; | |
528 | } | |
529 | ||
530 | # If the value of the filled-in text really was undef, | |
531 | # change it to an explicit empty string to avoid undefined | |
532 | # value warnings later. | |
533 | $fi_res = '' unless defined $fi_res; | |
534 | ||
535 | $fi_r .= $fi_res; | |
536 | } | |
537 | } | |
538 | ||
539 | return $fi_r; | |
540 | } | |
541 | ||
542 | sub _MassageSimpleTemplateArgs { | |
543 | my $self = shift; | |
544 | my %args = ( | |
545 | TemplateArgs => {}, | |
546 | @_, | |
547 | ); | |
548 | ||
549 | my $template_args = $args{TemplateArgs}; | |
550 | ||
551 | if (my $ticket = $template_args->{Ticket}) { | |
552 | for my $column (qw/Id Subject Type InitialPriority FinalPriority Priority TimeEstimated TimeWorked Status TimeLeft Told Starts Started Due Resolved RequestorAddresses AdminCcAddresses CcAddresses/) { | |
553 | $template_args->{"Ticket".$column} = $ticket->$column; | |
554 | } | |
555 | ||
556 | $template_args->{"TicketQueueId"} = $ticket->Queue; | |
557 | $template_args->{"TicketQueueName"} = $ticket->QueueObj->Name; | |
558 | ||
559 | $template_args->{"TicketOwnerId"} = $ticket->Owner; | |
560 | $template_args->{"TicketOwnerName"} = $ticket->OwnerObj->Name; | |
561 | $template_args->{"TicketOwnerEmailAddress"} = $ticket->OwnerObj->EmailAddress; | |
562 | ||
563 | my $cfs = $ticket->CustomFields; | |
564 | while (my $cf = $cfs->Next) { | |
565 | $template_args->{"TicketCF" . $cf->Name} = $ticket->CustomFieldValuesAsString($cf->Name); | |
566 | } | |
567 | } | |
568 | ||
569 | if (my $txn = $template_args->{Transaction}) { | |
570 | for my $column (qw/Id TimeTaken Type Field OldValue NewValue Data Content Subject Description BriefDescription/) { | |
571 | $template_args->{"Transaction".$column} = $txn->$column; | |
572 | } | |
573 | ||
574 | my $cfs = $txn->CustomFields; | |
575 | while (my $cf = $cfs->Next) { | |
576 | $template_args->{"TransactionCF" . $cf->Name} = $txn->CustomFieldValuesAsString($cf->Name); | |
577 | } | |
578 | } | |
579 | } | |
580 | ||
581 | sub _DowngradeFromHTML { | |
582 | my $self = shift; | |
583 | my $orig_entity = $self->MIMEObj; | |
584 | ||
585 | my $new_entity = $orig_entity->dup; # this will fail badly if we go away from InCore parsing | |
586 | $new_entity->head->mime_attr( "Content-Type" => 'text/plain' ); | |
587 | $new_entity->head->mime_attr( "Content-Type.charset" => 'utf-8' ); | |
588 | ||
589 | $orig_entity->head->mime_attr( "Content-Type" => 'text/html' ); | |
590 | $orig_entity->head->mime_attr( "Content-Type.charset" => 'utf-8' ); | |
591 | $orig_entity->make_multipart('alternative', Force => 1); | |
592 | ||
593 | require HTML::FormatText; | |
594 | require HTML::TreeBuilder; | |
595 | require Encode; | |
596 | # need to decode_utf8, see the doc of MIMEObj method | |
597 | my $tree = HTML::TreeBuilder->new_from_content( | |
598 | Encode::decode_utf8($new_entity->bodyhandle->as_string) | |
599 | ); | |
600 | $new_entity->bodyhandle(MIME::Body::InCore->new( | |
601 | \(scalar HTML::FormatText->new( | |
602 | leftmargin => 0, | |
603 | rightmargin => 78, | |
604 | )->format( $tree )) | |
605 | )); | |
606 | $tree->delete; | |
607 | ||
608 | $orig_entity->add_part($new_entity, 0); # plain comes before html | |
609 | $self->{MIMEObj} = $orig_entity; | |
610 | ||
611 | return; | |
612 | } | |
613 | ||
614 | =head2 CurrentUserHasQueueRight | |
615 | ||
616 | Helper function to call the template's queue's CurrentUserHasQueueRight with the passed in args. | |
617 | ||
618 | =cut | |
619 | ||
620 | sub CurrentUserHasQueueRight { | |
621 | my $self = shift; | |
622 | return ( $self->QueueObj->CurrentUserHasRight(@_) ); | |
623 | } | |
624 | ||
625 | =head2 SetType | |
626 | ||
627 | If setting Type to Perl, require the ExecuteCode right. | |
628 | ||
629 | =cut | |
630 | ||
631 | sub SetType { | |
632 | my $self = shift; | |
633 | my $NewType = shift; | |
634 | ||
635 | if ($NewType eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) { | |
636 | return ( undef, $self->loc('Permission Denied') ); | |
637 | } | |
638 | ||
639 | return $self->_Set( Field => 'Type', Value => $NewType ); | |
640 | } | |
641 | ||
642 | =head2 SetContent | |
643 | ||
644 | If changing content and the type is Perl, require the ExecuteCode right. | |
645 | ||
646 | =cut | |
647 | ||
648 | sub SetContent { | |
649 | my $self = shift; | |
650 | my $NewContent = shift; | |
651 | ||
652 | if ($self->Type eq 'Perl' && !$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) { | |
653 | return ( undef, $self->loc('Permission Denied') ); | |
654 | } | |
655 | ||
656 | return $self->_Set( Field => 'Content', Value => $NewContent ); | |
657 | } | |
658 | ||
659 | sub _UpdateAttributes { | |
660 | my $self = shift; | |
661 | my %args = ( | |
662 | NewValues => {}, | |
663 | @_, | |
664 | ); | |
665 | ||
666 | my $type = $args{NewValues}{Type} || $self->Type; | |
667 | ||
668 | # forbid updating content when the (possibly new) value of Type is Perl | |
669 | if ($type eq 'Perl' && exists $args{NewValues}{Content}) { | |
670 | if (!$self->CurrentUser->HasRight(Right => 'ExecuteCode', Object => $RT::System)) { | |
671 | return $self->loc('Permission Denied'); | |
672 | } | |
673 | } | |
674 | ||
675 | return $self->SUPER::_UpdateAttributes(%args); | |
676 | } | |
677 | ||
678 | =head2 CompileCheck | |
679 | ||
680 | If the template's Type is Perl, then compile check all the codeblocks to see if | |
681 | they are syntactically valid. We eval them in a codeblock to avoid actually | |
682 | executing the code. | |
683 | ||
684 | Returns an (ok, message) pair. | |
685 | ||
686 | =cut | |
687 | ||
688 | sub CompileCheck { | |
689 | my $self = shift; | |
690 | ||
691 | return (1, $self->loc("Template does not include Perl code")) | |
692 | unless $self->Type eq 'Perl'; | |
693 | ||
694 | my $content = $self->Content; | |
695 | $content = '' if !defined($content); | |
696 | ||
697 | my $template = Text::Template->new( | |
698 | TYPE => 'STRING', | |
699 | SOURCE => $content, | |
700 | ); | |
701 | my ($ok) = $template->compile; | |
702 | return ( undef, $self->loc('Template parsing error: [_1]', $Text::Template::ERROR) ) if !$ok; | |
703 | ||
704 | # copied from Text::Template::fill_in and refactored to be compile checks | |
705 | foreach my $fi_item (@{$template->{SOURCE}}) { | |
706 | my ($fi_type, $fi_text, $fi_lineno) = @$fi_item; | |
707 | next unless $fi_type eq 'PROG'; | |
708 | ||
709 | do { | |
710 | no strict 'vars'; | |
711 | eval "sub { $fi_text }"; | |
712 | }; | |
713 | next if !$@; | |
714 | ||
715 | my $error = $@; | |
716 | ||
717 | # provide a (hopefully) useful line number for the error, but clean up | |
718 | # all the other extraneous garbage | |
719 | $error =~ s/\(eval \d+\) line (\d+).*/"template line " . ($1+$fi_lineno-1)/es; | |
720 | ||
721 | return (0, $self->loc("Couldn't compile template codeblock '[_1]': [_2]", $fi_text, $error)); | |
722 | } | |
723 | ||
724 | return (1, $self->loc("Template compiles")); | |
725 | } | |
726 | ||
727 | =head2 CurrentUserCanRead | |
728 | ||
729 | =cut | |
730 | ||
731 | sub CurrentUserCanRead { | |
732 | my $self =shift; | |
733 | ||
734 | return 1 if $self->CurrentUserHasQueueRight('ShowTemplate'); | |
735 | ||
736 | return $self->CurrentUser->HasRight( Right =>'ShowGlobalTemplates', Object => $RT::System ) | |
737 | if !$self->QueueObj->Id; | |
738 | ||
739 | return; | |
740 | } | |
741 | ||
742 | 1; | |
743 | ||
744 | use RT::Queue; | |
745 | use base 'RT::Record'; | |
746 | ||
747 | sub Table {'Templates'} | |
748 | ||
749 | ||
750 | ||
751 | ||
752 | ||
753 | ||
754 | =head2 id | |
755 | ||
756 | Returns the current value of id. | |
757 | (In the database, id is stored as int(11).) | |
758 | ||
759 | ||
760 | =cut | |
761 | ||
762 | ||
763 | =head2 Queue | |
764 | ||
765 | Returns the current value of Queue. | |
766 | (In the database, Queue is stored as int(11).) | |
767 | ||
768 | ||
769 | ||
770 | =head2 SetQueue VALUE | |
771 | ||
772 | ||
773 | Set Queue to VALUE. | |
774 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
775 | (In the database, Queue will be stored as a int(11).) | |
776 | ||
777 | ||
778 | =cut | |
779 | ||
780 | ||
781 | =head2 QueueObj | |
782 | ||
783 | Returns the Queue Object which has the id returned by Queue | |
784 | ||
785 | ||
786 | =cut | |
787 | ||
788 | sub QueueObj { | |
789 | my $self = shift; | |
790 | my $Queue = RT::Queue->new($self->CurrentUser); | |
791 | $Queue->Load($self->__Value('Queue')); | |
792 | return($Queue); | |
793 | } | |
794 | ||
795 | =head2 Name | |
796 | ||
797 | Returns the current value of Name. | |
798 | (In the database, Name is stored as varchar(200).) | |
799 | ||
800 | ||
801 | ||
802 | =head2 SetName VALUE | |
803 | ||
804 | ||
805 | Set Name to VALUE. | |
806 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
807 | (In the database, Name will be stored as a varchar(200).) | |
808 | ||
809 | ||
810 | =cut | |
811 | ||
812 | ||
813 | =head2 Description | |
814 | ||
815 | Returns the current value of Description. | |
816 | (In the database, Description is stored as varchar(255).) | |
817 | ||
818 | ||
819 | ||
820 | =head2 SetDescription VALUE | |
821 | ||
822 | ||
823 | Set Description to VALUE. | |
824 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
825 | (In the database, Description will be stored as a varchar(255).) | |
826 | ||
827 | ||
828 | =cut | |
829 | ||
830 | ||
831 | =head2 Type | |
832 | ||
833 | Returns the current value of Type. | |
834 | (In the database, Type is stored as varchar(16).) | |
835 | ||
836 | ||
837 | ||
838 | =head2 SetType VALUE | |
839 | ||
840 | ||
841 | Set Type to VALUE. | |
842 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
843 | (In the database, Type will be stored as a varchar(16).) | |
844 | ||
845 | ||
846 | =cut | |
847 | ||
848 | ||
849 | =head2 Language | |
850 | ||
851 | Returns the current value of Language. | |
852 | (In the database, Language is stored as varchar(16).) | |
853 | ||
854 | ||
855 | ||
856 | =head2 SetLanguage VALUE | |
857 | ||
858 | ||
859 | Set Language to VALUE. | |
860 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
861 | (In the database, Language will be stored as a varchar(16).) | |
862 | ||
863 | ||
864 | =cut | |
865 | ||
866 | ||
867 | =head2 TranslationOf | |
868 | ||
869 | Returns the current value of TranslationOf. | |
870 | (In the database, TranslationOf is stored as int(11).) | |
871 | ||
872 | ||
873 | ||
874 | =head2 SetTranslationOf VALUE | |
875 | ||
876 | ||
877 | Set TranslationOf to VALUE. | |
878 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
879 | (In the database, TranslationOf will be stored as a int(11).) | |
880 | ||
881 | ||
882 | =cut | |
883 | ||
884 | ||
885 | =head2 Content | |
886 | ||
887 | Returns the current value of Content. | |
888 | (In the database, Content is stored as text.) | |
889 | ||
890 | ||
891 | ||
892 | =head2 SetContent VALUE | |
893 | ||
894 | ||
895 | Set Content to VALUE. | |
896 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
897 | (In the database, Content will be stored as a text.) | |
898 | ||
899 | ||
900 | =cut | |
901 | ||
902 | ||
903 | =head2 LastUpdated | |
904 | ||
905 | Returns the current value of LastUpdated. | |
906 | (In the database, LastUpdated is stored as datetime.) | |
907 | ||
908 | ||
909 | =cut | |
910 | ||
911 | ||
912 | =head2 LastUpdatedBy | |
913 | ||
914 | Returns the current value of LastUpdatedBy. | |
915 | (In the database, LastUpdatedBy is stored as int(11).) | |
916 | ||
917 | ||
918 | =cut | |
919 | ||
920 | ||
921 | =head2 Creator | |
922 | ||
923 | Returns the current value of Creator. | |
924 | (In the database, Creator is stored as int(11).) | |
925 | ||
926 | ||
927 | =cut | |
928 | ||
929 | ||
930 | =head2 Created | |
931 | ||
932 | Returns the current value of Created. | |
933 | (In the database, Created is stored as datetime.) | |
934 | ||
935 | ||
936 | =cut | |
937 | ||
938 | ||
939 | ||
940 | sub _CoreAccessible { | |
941 | { | |
942 | ||
943 | id => | |
944 | {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, | |
945 | Queue => | |
946 | {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, | |
947 | Name => | |
948 | {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, | |
949 | Description => | |
950 | {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, | |
951 | Type => | |
952 | {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, | |
953 | Language => | |
954 | {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, | |
955 | TranslationOf => | |
956 | {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, | |
957 | Content => | |
958 | {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, | |
959 | LastUpdated => | |
960 | {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, | |
961 | LastUpdatedBy => | |
962 | {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, | |
963 | Creator => | |
964 | {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, | |
965 | Created => | |
966 | {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, | |
967 | ||
968 | } | |
969 | }; | |
970 | ||
971 | RT::Base->_ImportOverlays(); | |
972 | ||
973 | 1; |