summaryrefslogtreecommitdiff
path: root/LedgerSMB/Template.pm
blob: 59fc4d01b229307285908652937ba1f2092b492a (plain)
  1. =head1 NAME
  2. LedgerSMB::Template - Template support module for LedgerSMB
  3. =head1 SYNOPSIS
  4. This module renders templates.
  5. =head1 METHODS
  6. =over
  7. =item new(user => \%myconfig, template => $string, format => $string, [locale => $locale] [language => $string], [include_path => $path], [no_auto_output => $bool], [method => $string], [no_escape => $bool], [debug => $bool], [output_file => $string] );
  8. This command instantiates a new template:
  9. =over
  10. =item template
  11. The template to be processed. This can either be a reference to the template
  12. in string form or the name of the file that is the template to be processed.
  13. =item format
  14. The format to be used. Currently HTML, PS, PDF, TXT and CSV are supported.
  15. =item format_options (optional)
  16. A hash of format-specific options. See the appropriate LSMB::T::foo for
  17. details.
  18. =item output_options (optional)
  19. A hash of output-specific options. See the appropriate output method for
  20. details.
  21. =item locale (optional)
  22. The locale object to use for regular gettext lookups. Having this option adds
  23. the text function to the usable list for the templates. Has no effect on the
  24. gettext function.
  25. =item language (optional)
  26. The language for template selection.
  27. =item include_path (optional)
  28. Overrides the template directory. Used with user interface templates.
  29. =item no_auto_output (optional)
  30. Disables the automatic output of rendered templates.
  31. =item no_escape (optional)
  32. Disables escaping on the template variables.
  33. =item debug (optional)
  34. Enables template debugging.
  35. With the TT-based renderers, HTML, PS, PDF, TXT, and CSV, the portion of the
  36. template to get debugging messages is to be surrounded by
  37. <?lsmb DEBUG format 'foo' ?> statements. Example:
  38. <tr><td colspan="<?lsmb columns.size ?>"></td></tr>
  39. <tr class="listheading">
  40. <?lsmb FOREACH column IN columns ?>
  41. <?lsmb DEBUG format '$file line $line : [% $text %]' ?>
  42. <th class="listtop"><?lsmb heading.$column ?></th>
  43. <?lsmb DEBUG format '' ?>
  44. <?lsmb END ?>
  45. </tr>
  46. =item method/media (optional)
  47. The output method to use, defaults to HTTP. Media is a synonym for method
  48. =item output_file (optional)
  49. The base name of the file for output.
  50. =back
  51. =item new_UI(user => \%myconfig, locale => $locale, template => $file, ...)
  52. Wrapper around the constructor that sets the path to 'UI', format to 'HTML',
  53. and leaves auto-output enabled.
  54. =item render($hashref)
  55. This command renders the template. If no_auto_output was not specified during
  56. instantiation, this also writes the result to standard output and exits.
  57. Otherwise it returns the name of the output file if a file was created. When
  58. no output file is created, the output is held in $self->{output}.
  59. Currently email and server-side printing are not supported.
  60. =item output
  61. This function outputs the rendered file in an appropriate manner.
  62. =item my $bool = _valid_language()
  63. This command checks for valid langages. Returns 1 if the language is valid,
  64. 0 if it is not.
  65. =back
  66. =head1 Copyright 2007, The LedgerSMB Core Team
  67. This file is licensed under the GNU General Public License version 2, or at your
  68. option any later version. A copy of the license should have been included with
  69. your software.
  70. =cut
  71. package LedgerSMB::Template;
  72. use warnings;
  73. use strict;
  74. use Carp;
  75. use Error qw(:try);
  76. use LedgerSMB::Sysconfig;
  77. use LedgerSMB::Mailer;
  78. sub new {
  79. my $class = shift;
  80. my $self = {};
  81. my %args = @_;
  82. $self->{myconfig} = $args{user};
  83. $self->{template} = $args{template};
  84. $self->{format} = $args{format};
  85. $self->{language} = $args{language};
  86. $self->{no_escape} = $args{no_escape};
  87. $self->{debug} = $args{debug};
  88. $self->{outputfile} =
  89. "${LedgerSMB::Sysconfig::tempdir}/$args{output_file}" if
  90. $args{output_file};
  91. $self->{include_path} = $args{path};
  92. $self->{locale} = $args{locale};
  93. $self->{noauto} = $args{no_auto_output};
  94. $self->{method} = $args{method};
  95. $self->{method} ||= $args{media};
  96. $self->{format_args} = $args{format_options};
  97. $self->{output_args} = $args{output_options};
  98. # SC: Muxing pre-format_args LaTeX format specifications. Now with
  99. # DVI support.
  100. if (lc $self->{format} eq 'dvi') {
  101. $self->{format} = 'LaTeX';
  102. $self->{format_args}{filetype} = 'dvi';
  103. } elsif (lc $self->{format} eq 'pdf') {
  104. $self->{format} = 'LaTeX';
  105. $self->{format_args}{filetype} = 'pdf';
  106. } elsif (lc $self->{format} eq 'ps' or lc $self->{format} eq 'postscript') {
  107. $self->{format} = 'LaTeX';
  108. $self->{format_args}{filetype} = 'ps';
  109. }
  110. bless $self, $class;
  111. if ($self->{format} !~ /^\p{IsAlnum}+$/) {
  112. throw Error::Simple "Invalid format";
  113. }
  114. if (!$self->{include_path}){
  115. ## SC: XXX hardcoding due to config migration, will need adjustment
  116. $self->{include_path} = $self->{'myconfig'}->{'templates'};
  117. $self->{include_path} ||= 'templates/demo';
  118. if (defined $self->{language}){
  119. if (!$self->_valid_language){
  120. throw Error::Simple 'Invalid language';
  121. return undef;
  122. }
  123. $self->{include_path} = "$self->{'include_path'}"
  124. ."/$self->{language}"
  125. .";$self->{'include_path'}"
  126. }
  127. }
  128. return $self;
  129. }
  130. sub new_UI {
  131. my $class = shift;
  132. return $class->new(@_, no_auto_ouput => 0, format => 'HTML', path => 'UI');
  133. }
  134. sub _valid_language {
  135. my $self = shift;
  136. if ($self->{language} =~ m#(/|\\|:|\.\.|^\.)#){
  137. return 0;
  138. }
  139. return 1;
  140. }
  141. sub _preprocess {
  142. my ($self, $vars) = @_;
  143. return unless $self->{myconfig};
  144. use LedgerSMB;
  145. if (UNIVERSAL::isa($vars, 'Math::BigFloat')){
  146. $vars =
  147. LedgerSMB::format_amount('LedgerSMB',
  148. amount => $vars,
  149. user => $self->{myconfig},
  150. precision => 2);
  151. }
  152. my $type = ref($vars);
  153. if ($type eq 'SCALAR' || !$type){
  154. return;
  155. }
  156. if ($type eq 'ARRAY'){
  157. for (@$vars){
  158. if (ref($_)){
  159. $self->_preprocess($_);
  160. }
  161. }
  162. }
  163. else {
  164. for my $key (keys %$vars){
  165. $self->_preprocess($vars->{$key});
  166. }
  167. }
  168. }
  169. sub render {
  170. my $self = shift;
  171. my $vars = shift;
  172. if ($self->{format} !~ /^\p{IsAlnum}+$/) {
  173. throw Error::Simple "Invalid format";
  174. }
  175. my $format = "LedgerSMB::Template::$self->{format}";
  176. # if ($self->{myconfig}){
  177. # $self->_preprocess($vars);
  178. # }
  179. eval "require $format";
  180. if ($@) {
  181. throw Error::Simple $@;
  182. }
  183. my $cleanvars;
  184. if ($self->{no_escape}) {
  185. carp 'no_escape mode enabled in rendering';
  186. $cleanvars = $vars;
  187. } else {
  188. $cleanvars = $format->can('preprocess')->($vars);
  189. }
  190. if (UNIVERSAL::isa($self->{locale}, 'LedgerSMB::Locale')){
  191. $cleanvars->{text} = sub { return $self->{locale}->text(@_)};
  192. }
  193. else {
  194. $cleanvars->{text} = sub { return shift @_ };
  195. }
  196. $cleanvars->{tt_url} = sub {
  197. my $str = shift @_;
  198. my $regex = qr/([^a-zA-Z0-9_.-])/;
  199. $str =~ s/$regex/sprintf("%%%02x", ord($1))/ge;
  200. return $str;
  201. };
  202. $format->can('process')->($self, $cleanvars);
  203. #return $format->can('postprocess')->($self);
  204. my $post = $format->can('postprocess')->($self);
  205. if (!$self->{'noauto'}) {
  206. # Clean up
  207. $self->output;
  208. if ($self->{rendered}) {
  209. unlink($self->{rendered}) or
  210. throw Error::Simple 'Unable to delete output file';
  211. }
  212. }
  213. return $post;
  214. }
  215. sub output {
  216. my $self = shift;
  217. my %args = @_;
  218. $self->{output_args} = \%args;
  219. my $method = $self->{method} || $args{method} || $args{media};
  220. if ('email' eq lc $method) {
  221. $self->_email_output;
  222. } elsif ('print' eq lc $method) {
  223. $self->_lpr_output;
  224. } elsif (defined $self->{output} or lc $method eq 'screen') {
  225. $self->_http_output;
  226. exit;
  227. } elsif (defined $method) {
  228. $self->_lpr_output;
  229. } else {
  230. $self->_http_output_file;
  231. }
  232. }
  233. sub _http_output {
  234. my ($self, $data) = @_;
  235. $data ||= $self->{output};
  236. if ($self->{format} !~ /^\p{IsAlnum}+$/) {
  237. throw Error::Simple "Invalid format";
  238. }
  239. if (!defined $data and defined $self->{rendered}){
  240. $data = "";
  241. open (DATA, '<', $self->{rendered});
  242. while (my $line = <DATA>){
  243. $data .= $line;
  244. }
  245. }
  246. my $format = "LedgerSMB::Template::$self->{format}";
  247. my $disposition = "";
  248. my $name = $format->can('postprocess')->($self);
  249. if ($name) {
  250. $name =~ s#^.*/##;
  251. $disposition .= qq|\nContent-Disposition: attachment; filename="$name"|;
  252. }
  253. if ($self->{mimetype} =~ /^text/) {
  254. print "Content-Type: $self->{mimetype}; charset=utf-8$disposition\n\n";
  255. binmode STDOUT, ':utf8';
  256. } else {
  257. print "Content-Type: $self->{mimetype}$disposition\n\n";
  258. binmode STDOUT, ':bytes';
  259. }
  260. print $data;
  261. binmode STDOUT, ':utf8';
  262. }
  263. sub _http_output_file {
  264. my $self = shift;
  265. my $FH;
  266. open($FH, '<:bytes', $self->{rendered}) or
  267. throw Error::Simple 'Unable to open rendered file';
  268. my $data;
  269. {
  270. local $/;
  271. $data = <$FH>;
  272. }
  273. close($FH);
  274. $self->_http_output($data);
  275. unlink($self->{rendered}) or
  276. throw Error::Simple 'Unable to delete output file';
  277. exit;
  278. }
  279. sub _email_output {
  280. my $self = shift;
  281. my $args = $self->{output_args};
  282. my @mailmime;
  283. if (!$self->{rendered} and !$args->{attach}) {
  284. $args->{message} .= $self->{output};
  285. @mailmime = ('contenttype', $self->{mimeytype});
  286. }
  287. my $mail = new LedgerSMB::Mailer(
  288. from => $args->{from} || $self->{user}->{email},
  289. to => $args->{to},
  290. cc => $args->{cc},
  291. bcc => $args->{bcc},
  292. subject => $args->{subject},
  293. notify => $args->{notify},
  294. message => $args->{message},
  295. @mailmime,
  296. );
  297. if ($args->{attach} or $self->{mimetype} !~ m#^text/# or $self->{rendered}) {
  298. my @attachment;
  299. my $name = $args->{filename};
  300. if ($self->{rendered}) {
  301. @attachment = ('file', $self->{rendered});
  302. $name ||= $self->{rendered};
  303. } else {
  304. @attachment = ('data', $self->{output});
  305. }
  306. $mail->attach(
  307. mimetype => $self->{mimetype},
  308. filename => $name,
  309. strip => $$,
  310. @attachment,
  311. );
  312. }
  313. $mail->send;
  314. }
  315. sub _lpr_output {
  316. my ($self, $in_args) = shift;
  317. my $args = $self->{output_args};
  318. if ($self->{format} ne 'LaTeX') {
  319. throw Error::Simple "Invalid Format";
  320. }
  321. my $lpr = $LedgerSMB::Sysconfig::printer{$args->{media}};
  322. open (LPR, '|-', $lpr);
  323. # Output is not defined here. In the future we should consider
  324. # changing this to use the system command and hit the file as an arg.
  325. # -- CT
  326. open (FILE, '<', "$self->{rendered}");
  327. while (my $line = <FILE>){
  328. print LPR $line;
  329. }
  330. close(LPR);
  331. }
  332. 1;