SL/Template/Plugin/L.pm

   1 package SL::Template::Plugin::L;
   2
   3 use base qw( Template::Plugin );
   4 use Template::Plugin;
   5 use List::MoreUtils qw(apply);
   6 use List::Util qw(max);
   7
   8 use strict;
   9
  10 { # This will give you an id for identifying html tags and such.
  11   # It's guaranteed to be unique unless you exceed 10 mio calls per request.
  12   # Do not use these id's to store information across requests.
  13 my $_id_sequence = int rand 1e7;
  14 sub _tag_id {
  15   return $_id_sequence = ($_id_sequence + 1) % 1e7;
  16 }
  17 }
  18
  19 sub _H {
  20   my $string = shift;
  21   return $::locale->quote_special_chars('HTML', $string);
  22 }
  23
  24 sub _J {
  25   my $string =  "" . shift;
  26   $string    =~ s/\"/\\\"/g;
  27   return $string;
  28 }
  29
  30 sub _hashify {
  31   return (@_ && (ref($_[0]) eq 'HASH')) ? %{ $_[0] } : @_;
  32 }
  33
  34 sub new {
  35   my ($class, $context, @args) = @_;
  36
  37   return bless {
  38     CONTEXT => $context,
  39   }, $class;
  40 }
  41
  42 sub _context {
  43   die 'not an accessor' if @_ > 1;
  44   return $_[0]->{CONTEXT};
  45 }
  46
  47 sub name_to_id {
  48   my $self =  shift;
  49   my $name =  shift;
  50
  51   $name    =~ s/[^\w_]/_/g;
  52   $name    =~ s/_+/_/g;
  53
  54   return $name;
  55 }
  56
  57 sub attributes {
  58   my $self    = shift;
  59   my %options = _hashify(@_);
  60
  61   my @result = ();
  62   while (my ($name, $value) = each %options) {
  63     next unless $name;
  64     $value = '' if !defined($value);
  65     push @result, _H($name) . '="' . _H($value) . '"';
  66   }
  67
  68   return @result ? ' ' . join(' ', @result) : '';
  69 }
  70
  71 sub html_tag {
  72   my $self       = shift;
  73   my $tag        = shift;
  74   my $content    = shift;
  75   my $attributes = $self->attributes(@_);
  76
  77   return "<${tag}${attributes}/>" unless defined($content);
  78   return "<${tag}${attributes}>${content}</${tag}>";
  79 }
  80
  81 sub select_tag {
  82   my $self            = shift;
  83   my $name            = shift;
  84   my $options_str     = shift;
  85   my %attributes      = _hashify(@_);
  86
  87   $attributes{id}   ||= $self->name_to_id($name);
  88   $options_str        = $self->options_for_select($options_str) if ref $options_str;
  89
  90   return $self->html_tag('select', $options_str, %attributes, name => $name);
  91 }
  92
  93 sub textarea_tag {
  94   my ($self, $name, $content, @slurp) = @_;
  95   my %attributes      = _hashify(@slurp);
  96
  97   $attributes{id}   ||= $self->name_to_id($name);
  98   $content            = $content ? _H($content) : '';
  99
 100   return $self->html_tag('textarea', $content, %attributes, name => $name);
 101 }
 102
 103 sub checkbox_tag {
 104   my $self             = shift;
 105   my $name             = shift;
 106   my %attributes       = _hashify(@_);
 107
 108   $attributes{id}    ||= $self->name_to_id($name);
 109   $attributes{value}   = 1 unless defined $attributes{value};
 110   my $label            = delete $attributes{label};
 111
 112   if ($attributes{checked}) {
 113     $attributes{checked} = 'checked';
 114   } else {
 115     delete $attributes{checked};
 116   }
 117
 118   my $code  = $self->html_tag('input', undef,  %attributes, name => $name, type => 'checkbox');
 119   $code    .= $self->html_tag('label', $label, for => $attributes{id}) if $label;
 120
 121   return $code;
 122 }
 123
 124 sub radio_button_tag {
 125   my $self             = shift;
 126   my $name             = shift;
 127   my %attributes       = _hashify(@_);
 128
 129   $attributes{value}   = 1 unless defined $attributes{value};
 130   $attributes{id}    ||= $self->name_to_id($name . "_" . $attributes{value});
 131   my $label            = delete $attributes{label};
 132
 133   if ($attributes{checked}) {
 134     $attributes{checked} = 'checked';
 135   } else {
 136     delete $attributes{checked};
 137   }
 138
 139   my $code  = $self->html_tag('input', undef,  %attributes, name => $name, type => 'radio');
 140   $code    .= $self->html_tag('label', $label, for => $attributes{id}) if $label;
 141
 142   return $code;
 143 }
 144
 145 sub input_tag {
 146   my ($self, $name, $value, @slurp) = @_;
 147   my %attributes      = _hashify(@slurp);
 148
 149   $attributes{id}   ||= $self->name_to_id($name);
 150   $attributes{type} ||= 'text';
 151
 152   return $self->html_tag('input', undef, %attributes, name => $name, value => $value);
 153 }
 154
 155 sub hidden_tag {
 156   return shift->input_tag(@_, type => 'hidden');
 157 }
 158
 159 sub div_tag {
 160   my ($self, $content, @slurp) = @_;
 161   return $self->html_tag('div', $content, @slurp);
 162 }
 163
 164 sub ul_tag {
 165   my ($self, $content, @slurp) = @_;
 166   return $self->html_tag('ul', $content, @slurp);
 167 }
 168
 169 sub li_tag {
 170   my ($self, $content, @slurp) = @_;
 171   return $self->html_tag('li', $content, @slurp);
 172 }
 173
 174 sub link {
 175   my ($self, $href, $content, @slurp) = @_;
 176   my %params = _hashify(@slurp);
 177
 178   $href ||= '#';
 179
 180   return $self->html_tag('a', $content, %params, href => $href);
 181 }
 182
 183 sub submit_tag {
 184   my ($self, $name, $value, @slurp) = @_;
 185   my %attributes = _hashify(@slurp);
 186
 187   $attributes{onclick} = "if (confirm('" . delete($attributes{confirm}) . "')) return true; else return false;" if $attributes{confirm};
 188
 189   return $self->input_tag($name, $value, %attributes, type => 'submit', class => 'submit');
 190 }
 191
 192 sub button_tag {
 193   my ($self, $onclick, $value, @slurp) = @_;
 194   my %attributes = _hashify(@slurp);
 195
 196   return $self->input_tag(undef, $value, %attributes, type => 'button', onclick => $onclick);
 197 }
 198
 199 sub options_for_select {
 200   my $self            = shift;
 201   my $collection      = shift;
 202   my %options         = _hashify(@_);
 203
 204   my $value_key       = $options{value} || 'id';
 205   my $title_key       = $options{title} || $value_key;
 206
 207   my $value_sub       = $options{value_sub};
 208   my $title_sub       = $options{title_sub};
 209
 210   my $value_title_sub = $options{value_title_sub};
 211
 212   my %selected        = map { ( $_ => 1 ) } @{ ref($options{default}) eq 'ARRAY' ? $options{default} : $options{default} ? [ $options{default} ] : [] };
 213
 214   my $access = sub {
 215     my ($element, $index, $key, $sub) = @_;
 216     my $ref = ref $element;
 217     return  $sub            ? $sub->($element)
 218          : !$ref            ? $element
 219          :  $ref eq 'ARRAY' ? $element->[$index]
 220          :  $ref eq 'HASH'  ? $element->{$key}
 221          :                    $element->$key;
 222   };
 223
 224   my @elements = ();
 225   push @elements, [ undef, $options{empty_title} || '' ] if $options{with_empty};
 226   push @elements, map [
 227     $value_title_sub ? $value_title_sub->($_) : (
 228       $access->($_, 0, $value_key, $value_sub),
 229       $access->($_, 1, $title_key, $title_sub),
 230     )
 231   ], @{ $collection } if $collection && ref $collection eq 'ARRAY';
 232
 233   my $code = '';
 234   foreach my $result (@elements) {
 235     my %attributes = ( value => $result->[0] );
 236     $attributes{selected} = 'selected' if $selected{ $result->[0] || '' };
 237
 238     $code .= $self->html_tag('option', _H($result->[1]), %attributes);
 239   }
 240
 241   return $code;
 242 }
 243
 244 sub javascript {
 245   my ($self, $data) = @_;
 246   return $self->html_tag('script', $data, type => 'text/javascript');
 247 }
 248
 249 sub stylesheet_tag {
 250   my $self = shift;
 251   my $code = '';
 252
 253   foreach my $file (@_) {
 254     $file .= '.css'        unless $file =~ m/\.css$/;
 255     $file  = "css/${file}" unless $file =~ m|/|;
 256
 257     $code .= qq|<link rel="stylesheet" href="${file}" type="text/css" media="screen" />|;
 258   }
 259
 260   return $code;
 261 }
 262
 263 sub date_tag {
 264   my ($self, $name, $value, @slurp) = @_;
 265   my %params   = _hashify(@slurp);
 266   my $name_e   = _H($name);
 267   my $seq      = _tag_id();
 268   my $datefmt  = apply {
 269     s/d+/\%d/gi;
 270     s/m+/\%m/gi;
 271     s/y+/\%Y/gi;
 272   } $::myconfig{"dateformat"};
 273
 274   $params{cal_align} ||= 'BR';
 275
 276   $self->input_tag($name, $value,
 277     id     => $name_e,
 278     size   => 11,
 279     title  => _H($::myconfig{dateformat}),
 280     onBlur => 'check_right_date_format(this)',
 281     %params,
 282   ) . ((!$params{no_cal}) ?
 283   $self->html_tag('img', undef,
 284     src    => 'image/calendar.png',
 285     id     => "trigger$seq",
 286     title  => _H($::myconfig{dateformat}),
 287     %params,
 288   ) .
 289   $self->javascript(
 290     "Calendar.setup({ inputField: '$name_e', ifFormat: '$datefmt', align: '$params{cal_align}', button: 'trigger$seq' });"
 291   ) : '');
 292
 293 sub javascript_tag {
 294   my $self = shift;
 295   my $code = '';
 296
 297   foreach my $file (@_) {
 298     $file .= '.js'        unless $file =~ m/\.js$/;
 299     $file  = "js/${file}" unless $file =~ m|/|;
 300
 301     $code .= qq|<script type="text/javascript" src="${file}"></script>|;
 302   }
 303
 304   return $code;
 305 }
 306
 307 sub tabbed {
 308   my ($self, $tabs, @slurp) = @_;
 309   my %params   = _hashify(@slurp);
 310   my $id       = 'tab_' . _tag_id();
 311
 312   $params{selected} *= 1;
 313
 314   die 'L.tabbed needs an arrayred of tabs for first argument'
 315     unless ref $tabs eq 'ARRAY';
 316
 317   my (@header, @blocks);
 318   for my $i (0..$#$tabs) {
 319     my $tab = $tabs->[$i];
 320
 321     next if $tab eq '';
 322
 323     my $selected = $params{selected} == $i;
 324     my $tab_id = _tag_id();
 325     push @header, $self->li_tag(
 326       $self->link('', $tab->{name}, rel => $tab_id),
 327         ($selected ? (class => 'selected') : ())
 328     );
 329     push @blocks, $self->div_tag($tab->{data},
 330       id => $tab_id, class => 'tabcontent');
 331   }
 332
 333   return '' unless @header;
 334   return $self->ul_tag(
 335     join('', @header), id => $id, class => 'shadetabs'
 336   ) .
 337   $self->div_tag(
 338     join('', @blocks), class => 'tabcontentstyle'
 339   ) .
 340   $self->javascript(
 341     qq|var $id = new ddtabcontent("$id");$id.setpersist(true);| .
 342     qq|$id.setselectedClassTarget("link");$id.init();|
 343   );
 344 }
 345
 346 sub tab {
 347   my ($self, $name, $src, @slurp) = @_;
 348   my %params = _hashify(@slurp);
 349
 350   $params{method} ||= 'process';
 351
 352   return () if defined $params{if} && !$params{if};
 353
 354   my $data;
 355   if ($params{method} eq 'raw') {
 356     $data = $src;
 357   } elsif ($params{method} eq 'process') {
 358     $data = $self->_context->process($src, %{ $params{args} || {} });
 359   } else {
 360     die "unknown tag method '$params{method}'";
 361   }
 362
 363   return () unless $data;
 364
 365   return +{ name => $name, data => $data };
 366 }
 367
 368 sub areainput_tag {
 369   my ($self, $name, $value, @slurp) = @_;
 370   my %attributes      = _hashify(@slurp);
 371
 372   my $rows = delete $attributes{rows}     || 1;
 373   my $min  = delete $attributes{min_rows} || 1;
 374
 375   return $rows > 1
 376     ? $self->textarea_tag($name, $value, %attributes, rows => max $rows, $min)
 377     : $self->input_tag($name, $value, %attributes);
 378 }
 379
 380 sub multiselect2side {
 381   my ($self, $id, @slurp) = @_;
 382   my %params              = _hashify(@slurp);
 383
 384   $params{labelsx}        = "\"" . _J($params{labelsx} || $::locale->text('Available')) . "\"";
 385   $params{labeldx}        = "\"" . _J($params{labeldx} || $::locale->text('Selected'))  . "\"";
 386   $params{moveOptions}    = 'false';
 387
 388   my $vars                = join(', ', map { "${_}: " . $params{$_} } keys %params);
 389   my $code                = <<EOCODE;
 390 <script type="text/javascript">
 391   \$().ready(function() {
 392     \$('#${id}').multiselect2side({ ${vars} });
 393   });
 394 </script>
 395 EOCODE
 396
 397   return $code;
 398 }
 399
 400 sub dump {
 401   my $self = shift;
 402   require Data::Dumper;
 403   return '<pre>' . Data::Dumper::Dumper(@_) . '</pre>';
 404 }
 405
 406 1;
 407
 408 __END__
 409
 410 =head1 NAME
 411
 412 SL::Templates::Plugin::L -- Layouting / tag generation
 413
 414 =head1 SYNOPSIS
 415
 416 Usage from a template:
 417
 418   [% USE L %]
 419
 420   [% L.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right' ] ]) %]
 421
 422   [% L.select_tag('direction', L.options_for_select([ { direction => 'left',  display => 'To the left'  },
 423                                                       { direction => 'right', display => 'To the right' } ],
 424                                                     value => 'direction', title => 'display', default => 'right')) %]
 425
 426 =head1 DESCRIPTION
 427
 428 A module modeled a bit after Rails' ActionView helpers. Several small
 429 functions that create HTML tags from various kinds of data sources.
 430
 431 =head1 FUNCTIONS
 432
 433 =head2 LOW-LEVEL FUNCTIONS
 434
 435 =over 4
 436
 437 =item C<name_to_id $name>
 438
 439 Converts a name to a HTML id by replacing various characters.
 440
 441 =item C<attributes %items>
 442
 443 Creates a string from all elements in C<%items> suitable for usage as
 444 HTML tag attributes. Keys and values are HTML escaped even though keys
 445 must not contain non-ASCII characters for browsers to accept them.
 446
 447 =item C<html_tag $tag_name, $content_string, %attributes>
 448
 449 Creates an opening and closing HTML tag for C<$tag_name> and puts
 450 C<$content_string> between the two. If C<$content_string> is undefined
 451 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
 452 are key/value pairs added to the opening tag.
 453
 454 C<$content_string> is not HTML escaped.
 455
 456 =back
 457
 458 =head2 HIGH-LEVEL FUNCTIONS
 459
 460 =over 4
 461
 462 =item C<select_tag $name, $options_string, %attributes>
 463
 464 Creates a HTML 'select' tag named C<$name> with the contents
 465 C<$options_string> and with arbitrary HTML attributes from
 466 C<%attributes>. The tag's C<id> defaults to C<name_to_id($name)>.
 467
 468 The C<$options_string> is usually created by the
 469 L</options_for_select> function. If C<$options_string> is an array
 470 reference then it will be passed to L</options_for_select>
 471 automatically.
 472
 473 =item C<input_tag $name, $value, %attributes>
 474
 475 Creates a HTML 'input type=text' tag named C<$name> with the value
 476 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 477 tag's C<id> defaults to C<name_to_id($name)>.
 478
 479 =item C<hidden_tag $name, $value, %attributes>
 480
 481 Creates a HTML 'input type=hidden' tag named C<$name> with the value
 482 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 483 tag's C<id> defaults to C<name_to_id($name)>.
 484
 485 =item C<submit_tag $name, $value, %attributes>
 486
 487 Creates a HTML 'input type=submit class=submit' tag named C<$name> with the
 488 value C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 489 tag's C<id> defaults to C<name_to_id($name)>.
 490
 491 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
 492 be added via the C<onclick> handler asking the question given with
 493 C<$attributes{confirm}>. If request is only submitted if the user
 494 clicks the dialog's ok/yes button.
 495
 496 =item C<textarea_tag $name, $value, %attributes>
 497
 498 Creates a HTML 'textarea' tag named C<$name> with the content
 499 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 500 tag's C<id> defaults to C<name_to_id($name)>.
 501
 502 =item C<checkbox_tag $name, %attributes>
 503
 504 Creates a HTML 'input type=checkbox' tag named C<$name> with arbitrary
 505 HTML attributes from C<%attributes>. The tag's C<id> defaults to
 506 C<name_to_id($name)>. The tag's C<value> defaults to C<1>.
 507
 508 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
 509 created with said C<label>. No attribute named C<label> is created in
 510 that case.
 511
 512 =item C<date_tag $name, $value, cal_align =E<gt> $align_code, %attributes>
 513
 514 Creates a date input field, with an attached javascript that will open a
 515 calendar on click. The javascript ist by default anchoered at the bottom right
 516 sight. This can be overridden with C<cal_align>, see Calendar documentation for
 517 the details, usually you'll want a two letter abbreviation of the alignment.
 518 Right + Bottom becomes C<BL>.
 519
 520 =item C<radio_button_tag $name, %attributes>
 521
 522 Creates a HTML 'input type=radio' tag named C<$name> with arbitrary
 523 HTML attributes from C<%attributes>. The tag's C<value> defaults to
 524 C<1>. The tag's C<id> defaults to C<name_to_id($name . "_" . $value)>.
 525
 526 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
 527 created with said C<label>. No attribute named C<label> is created in
 528 that case.
 529
 530 =item C<javascript_tag $file1, $file2, $file3...>
 531
 532 Creates a HTML 'E<lt>script type="text/javascript" src="..."E<gt>'
 533 tag for each file name parameter passed. Each file name will be
 534 postfixed with '.js' if it isn't already and prefixed with 'js/' if it
 535 doesn't contain a slash.
 536
 537 =item C<stylesheet_tag $file1, $file2, $file3...>
 538
 539 Creates a HTML 'E<lt>link rel="text/stylesheet" href="..."E<gt>' tag
 540 for each file name parameter passed. Each file name will be postfixed
 541 with '.css' if it isn't already and prefixed with 'css/' if it doesn't
 542 contain a slash.
 543
 544 =item C<date_tag $name, $value, cal_align =E<gt> $align_code, %attributes>
 545
 546 Creates a date input field, with an attached javascript that will open a
 547 calendar on click. The javascript ist by default anchoered at the bottom right
 548 sight. This can be overridden with C<cal_align>, see Calendar documentation for
 549 the details, usually you'll want a two letter abbreviation of the alignment.
 550 Right + Bottom becomes C<BL>.
 551
 552 =item C<tabbed \@tab, %attributes>
 553
 554 Will create a tabbed area. The tabs should be created with the helper function
 555 C<tab>. Example:
 556
 557   [% L.tabbed([
 558     L.tab(LxERP.t8('Basic Data'),       'part/_main_tab.html'),
 559     L.tab(LxERP.t8('Custom Variables'), 'part/_cvar_tab.html', if => SELF.display_cvar_tab),
 560   ]) %]
 561
 562 An optional attribute is C<selected>, which accepts the ordinal of a tab which
 563 should be selected by default.
 564
 565 =item C<areainput_tag $name, $content, %PARAMS>
 566
 567 Creates a generic input tag or textarea tag, depending on content size. The
 568 mount of desired rows must be given with C<rows> parameter, Accpeted parameters
 569 include C<min_rows> for rendering a minimum of rows if a textarea is displayed.
 570
 571 You can force input by setting rows to 1, and you can force textarea by setting
 572 rows to anything >1.
 573
 574 =item C<multiselect2side $id, %params>
 575
 576 Creates a JavaScript snippet calling the jQuery function
 577 C<multiselect2side> on the select control with the ID C<$id>. The
 578 select itself is not created. C<%params> can contain the following
 579 entries:
 580
 581 =over 2
 582
 583 =item C<labelsx>
 584
 585 The label of the list of available options. Defaults to the
 586 translation of 'Available'.
 587
 588 =item C<labeldx>
 589
 590 The label of the list of selected options. Defaults to the
 591 translation of 'Selected'.
 592
 593 =back
 594
 595 =item C<dump REF>
 596
 597 Dumps the Argument using L<Data::Dumper> into a E<lt>preE<gt> block.
 598
 599 =back
 600
 601 =head2 CONVERSION FUNCTIONS
 602
 603 =over 4
 604
 605 =item C<options_for_select \@collection, %options>
 606
 607 Creates a string suitable for a HTML 'select' tag consisting of one
 608 'E<lt>optionE<gt>' tag for each element in C<\@collection>. The value
 609 to use and the title to display are extracted from the elements in
 610 C<\@collection>. Each element can be one of four things:
 611
 612 =over 12
 613
 614 =item 1. An array reference with at least two elements. The first element is
 615 the value, the second element is its title.
 616
 617 =item 2. A scalar. The scalar is both the value and the title.
 618
 619 =item 3. A hash reference. In this case C<%options> must contain
 620 I<value> and I<title> keys that name the keys in the element to use
 621 for the value and title respectively.
 622
 623 =item 4. A blessed reference. In this case C<%options> must contain
 624 I<value> and I<title> keys that name functions called on the blessed
 625 reference whose return values are used as the value and title
 626 respectively.
 627
 628 =back
 629
 630 For cases 3 and 4 C<$options{value}> defaults to C<id> and
 631 C<$options{title}> defaults to C<$options{value}>.
 632
 633 In addition to pure keys/method you can also provide coderefs as I<value_sub>
 634 and/or I<title_sub>. If present, these take precedence over keys or methods,
 635 and are called with the element as first argument. It must return the value or
 636 title.
 637
 638 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
 639 precedence over each individual sub. It will only be called once for each
 640 element and must return a list of value and title.
 641
 642 If the option C<with_empty> is set then an empty element (value
 643 C<undef>) will be used as the first element. The title to display for
 644 this element can be set with the option C<empty_title> and defaults to
 645 an empty string.
 646
 647 The option C<default> can be either a scalar or an array reference
 648 containing the values of the options which should be set to be
 649 selected.
 650
 651 =item C<tab, description, target, %PARAMS>
 652
 653 Creates a tab for C<tabbed>. The description will be used as displayed name.
 654 The target should be a block or template that can be processed. C<tab> supports
 655 a C<method> parameter, which can override the process method to apply target.
 656 C<method => 'raw'> will just include the given text as is. I was too lazy to
 657 implement C<include> properly.
 658
 659 Also an C<if> attribute is supported, so that tabs can be suppressed based on
 660 some occasion. In this case the supplied block won't even get processed, and
 661 the resulting tab will get ignored by C<tabbed>:
 662
 663   L.tab('Awesome tab wih much info', '_much_info.html', if => SELF.wants_all)
 664
 665 =back
 666
 667 =head1 MODULE AUTHORS
 668
 669 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 670
 671 L<http://linet-services.de>