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