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