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 1;
 401
 402 __END__
 403
 404 =head1 NAME
 405
 406 SL::Templates::Plugin::L -- Layouting / tag generation
 407
 408 =head1 SYNOPSIS
 409
 410 Usage from a template:
 411
 412   [% USE L %]
 413
 414   [% L.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right' ] ]) %]
 415
 416   [% L.select_tag('direction', L.options_for_select([ { direction => 'left',  display => 'To the left'  },
 417                                                       { direction => 'right', display => 'To the right' } ],
 418                                                     value => 'direction', title => 'display', default => 'right')) %]
 419
 420 =head1 DESCRIPTION
 421
 422 A module modeled a bit after Rails' ActionView helpers. Several small
 423 functions that create HTML tags from various kinds of data sources.
 424
 425 =head1 FUNCTIONS
 426
 427 =head2 LOW-LEVEL FUNCTIONS
 428
 429 =over 4
 430
 431 =item C<name_to_id $name>
 432
 433 Converts a name to a HTML id by replacing various characters.
 434
 435 =item C<attributes %items>
 436
 437 Creates a string from all elements in C<%items> suitable for usage as
 438 HTML tag attributes. Keys and values are HTML escaped even though keys
 439 must not contain non-ASCII characters for browsers to accept them.
 440
 441 =item C<html_tag $tag_name, $content_string, %attributes>
 442
 443 Creates an opening and closing HTML tag for C<$tag_name> and puts
 444 C<$content_string> between the two. If C<$content_string> is undefined
 445 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
 446 are key/value pairs added to the opening tag.
 447
 448 C<$content_string> is not HTML escaped.
 449
 450 =back
 451
 452 =head2 HIGH-LEVEL FUNCTIONS
 453
 454 =over 4
 455
 456 =item C<select_tag $name, $options_string, %attributes>
 457
 458 Creates a HTML 'select' tag named C<$name> with the contents
 459 C<$options_string> and with arbitrary HTML attributes from
 460 C<%attributes>. The tag's C<id> defaults to C<name_to_id($name)>.
 461
 462 The C<$options_string> is usually created by the
 463 L</options_for_select> function. If C<$options_string> is an array
 464 reference then it will be passed to L</options_for_select>
 465 automatically.
 466
 467 =item C<input_tag $name, $value, %attributes>
 468
 469 Creates a HTML 'input type=text' tag named C<$name> with the value
 470 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 471 tag's C<id> defaults to C<name_to_id($name)>.
 472
 473 =item C<hidden_tag $name, $value, %attributes>
 474
 475 Creates a HTML 'input type=hidden' 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<submit_tag $name, $value, %attributes>
 480
 481 Creates a HTML 'input type=submit class=submit' tag named C<$name> with the
 482 value 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 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
 486 be added via the C<onclick> handler asking the question given with
 487 C<$attributes{confirm}>. If request is only submitted if the user
 488 clicks the dialog's ok/yes button.
 489
 490 =item C<textarea_tag $name, $value, %attributes>
 491
 492 Creates a HTML 'textarea' tag named C<$name> with the content
 493 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 494 tag's C<id> defaults to C<name_to_id($name)>.
 495
 496 =item C<checkbox_tag $name, %attributes>
 497
 498 Creates a HTML 'input type=checkbox' tag named C<$name> with arbitrary
 499 HTML attributes from C<%attributes>. The tag's C<id> defaults to
 500 C<name_to_id($name)>. The tag's C<value> defaults to C<1>.
 501
 502 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
 503 created with said C<label>. No attribute named C<label> is created in
 504 that case.
 505
 506 =item C<date_tag $name, $value, cal_align =E<gt> $align_code, %attributes>
 507
 508 Creates a date input field, with an attached javascript that will open a
 509 calendar on click. The javascript ist by default anchoered at the bottom right
 510 sight. This can be overridden with C<cal_align>, see Calendar documentation for
 511 the details, usually you'll want a two letter abbreviation of the alignment.
 512 Right + Bottom becomes C<BL>.
 513
 514 =item C<radio_button_tag $name, %attributes>
 515
 516 Creates a HTML 'input type=radio' tag named C<$name> with arbitrary
 517 HTML attributes from C<%attributes>. The tag's C<value> defaults to
 518 C<1>. The tag's C<id> defaults to C<name_to_id($name . "_" . $value)>.
 519
 520 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
 521 created with said C<label>. No attribute named C<label> is created in
 522 that case.
 523
 524 =item C<javascript_tag $file1, $file2, $file3...>
 525
 526 Creates a HTML 'E<lt>script type="text/javascript" src="..."E<gt>'
 527 tag for each file name parameter passed. Each file name will be
 528 postfixed with '.js' if it isn't already and prefixed with 'js/' if it
 529 doesn't contain a slash.
 530
 531 =item C<stylesheet_tag $file1, $file2, $file3...>
 532
 533 Creates a HTML 'E<lt>link rel="text/stylesheet" href="..."E<gt>' tag
 534 for each file name parameter passed. Each file name will be postfixed
 535 with '.css' if it isn't already and prefixed with 'css/' if it doesn't
 536 contain a slash.
 537
 538 =item C<date_tag $name, $value, cal_align =E<gt> $align_code, %attributes>
 539
 540 Creates a date input field, with an attached javascript that will open a
 541 calendar on click. The javascript ist by default anchoered at the bottom right
 542 sight. This can be overridden with C<cal_align>, see Calendar documentation for
 543 the details, usually you'll want a two letter abbreviation of the alignment.
 544 Right + Bottom becomes C<BL>.
 545
 546 =item C<tabbed \@tab, %attributes>
 547
 548 Will create a tabbed area. The tabs should be created with the helper function
 549 C<tab>. Example:
 550
 551   [% L.tabbed([
 552     L.tab(LxERP.t8('Basic Data'),       'part/_main_tab.html'),
 553     L.tab(LxERP.t8('Custom Variables'), 'part/_cvar_tab.html', if => SELF.display_cvar_tab),
 554   ]) %]
 555
 556 An optional attribute is C<selected>, which accepts the ordinal of a tab which
 557 should be selected by default.
 558
 559 =item C<areainput_tag $name, $content, %PARAMS>
 560
 561 Creates a generic input tag or textarea tag, depending on content size. The
 562 mount of desired rows must be given with C<rows> parameter, Accpeted parameters
 563 include C<min_rows> for rendering a minimum of rows if a textarea is displayed.
 564
 565 You can force input by setting rows to 1, and you can force textarea by setting
 566 rows to anything >1.
 567
 568 =item C<multiselect2side $id, %params>
 569
 570 Creates a JavaScript snippet calling the jQuery function
 571 C<multiselect2side> on the select control with the ID C<$id>. The
 572 select itself is not created. C<%params> can contain the following
 573 entries:
 574
 575 =over 2
 576
 577 =item C<labelsx>
 578
 579 The label of the list of available options. Defaults to the
 580 translation of 'Available'.
 581
 582 =item C<labeldx>
 583
 584 The label of the list of selected options. Defaults to the
 585 translation of 'Selected'.
 586
 587 =back
 588
 589 =back
 590
 591 =head2 CONVERSION FUNCTIONS
 592
 593 =over 4
 594
 595 =item C<options_for_select \@collection, %options>
 596
 597 Creates a string suitable for a HTML 'select' tag consisting of one
 598 'E<lt>optionE<gt>' tag for each element in C<\@collection>. The value
 599 to use and the title to display are extracted from the elements in
 600 C<\@collection>. Each element can be one of four things:
 601
 602 =over 12
 603
 604 =item 1. An array reference with at least two elements. The first element is
 605 the value, the second element is its title.
 606
 607 =item 2. A scalar. The scalar is both the value and the title.
 608
 609 =item 3. A hash reference. In this case C<%options> must contain
 610 I<value> and I<title> keys that name the keys in the element to use
 611 for the value and title respectively.
 612
 613 =item 4. A blessed reference. In this case C<%options> must contain
 614 I<value> and I<title> keys that name functions called on the blessed
 615 reference whose return values are used as the value and title
 616 respectively.
 617
 618 =back
 619
 620 For cases 3 and 4 C<$options{value}> defaults to C<id> and
 621 C<$options{title}> defaults to C<$options{value}>.
 622
 623 In addition to pure keys/method you can also provide coderefs as I<value_sub>
 624 and/or I<title_sub>. If present, these take precedence over keys or methods,
 625 and are called with the element as first argument. It must return the value or
 626 title.
 627
 628 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
 629 precedence over each individual sub. It will only be called once for each
 630 element and must return a list of value and title.
 631
 632 If the option C<with_empty> is set then an empty element (value
 633 C<undef>) will be used as the first element. The title to display for
 634 this element can be set with the option C<empty_title> and defaults to
 635 an empty string.
 636
 637 The option C<default> can be either a scalar or an array reference
 638 containing the values of the options which should be set to be
 639 selected.
 640
 641 =item C<tab, description, target, %PARAMS>
 642
 643 Creates a tab for C<tabbed>. The description will be used as displayed name.
 644 The target should be a block or template that can be processed. C<tab> supports
 645 a C<method> parameter, which can override the process method to apply target.
 646 C<method => 'raw'> will just include the given text as is. I was too lazy to
 647 implement C<include> properly.
 648
 649 Also an C<if> attribute is supported, so that tabs can be suppressed based on
 650 some occasion. In this case the supplied block won't even get processed, and
 651 the resulting tab will get ignored by C<tabbed>:
 652
 653   L.tab('Awesome tab wih much info', '_much_info.html', if => SELF.wants_all)
 654
 655 =back
 656
 657 =head1 MODULE AUTHORS
 658
 659 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 660
 661 L<http://linet-services.de>