Main Koha release repository https://koha-community.org
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

176 lines
3.6 KiB

  1. package Koha::Template::Plugin::Asset;
  2. # Copyright 2018 BibLibre
  3. #
  4. # This file is part of Koha.
  5. #
  6. # Koha is free software; you can redistribute it and/or modify it
  7. # under the terms of the GNU General Public License as published by
  8. # the Free Software Foundation; either version 3 of the License, or
  9. # (at your option) any later version.
  10. #
  11. # Koha is distributed in the hope that it will be useful, but
  12. # WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. # GNU General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with Koha; if not, see <http://www.gnu.org/licenses>.
  18. =head1 NAME
  19. Koha::Template::Plugin::Asset
  20. =head1 DESCRIPTION
  21. The Asset plugin is a helper that generates HTML tags for JS and CSS files
  22. =head1 SYNOPSYS
  23. [% USE Asset %]
  24. [% Asset.css("css/datatables.css") %]
  25. [% Asset.js("js/datatables.js") %]
  26. [%# With attributes %]
  27. [% Asset.css("css/print.css", { media = "print" }) %]
  28. [%# If you only want the url and not the HTML tag %]
  29. [% url = Asset.url("css/datatables.css") %]
  30. =cut
  31. use Modern::Perl;
  32. use Template::Plugin;
  33. use base qw( Template::Plugin );
  34. use File::Basename;
  35. use File::Spec;
  36. use C4::Context;
  37. use Koha;
  38. =head1 FUNCTIONS
  39. =head2 new
  40. Constructor. Do not use this directly.
  41. =cut
  42. sub new {
  43. my ($class, $context) = @_;
  44. my $self = {
  45. _CONTEXT => $context,
  46. };
  47. return bless $self, $class;
  48. }
  49. =head2 js
  50. Returns a <script> tag for the given JS file
  51. [% Asset.js('js/datatables.js') %]
  52. =cut
  53. sub js {
  54. my ( $self, $filename, $attributes ) = @_;
  55. my $url = $self->url($filename);
  56. unless ($url) {
  57. warn "File not found : $filename";
  58. return;
  59. }
  60. $attributes->{src} = $url;
  61. return $self->_tag('script', $attributes) . '</script>';
  62. }
  63. =head2 css
  64. Returns a <link> tag for the given CSS file
  65. [% Asset.css('css/datatables.css') %]
  66. [% Asset.css('css/print.css', { media = "print" }) %]
  67. =cut
  68. sub css {
  69. my ( $self, $filename, $attributes ) = @_;
  70. my $url = $self->url($filename);
  71. unless ($url) {
  72. warn "File not found : $filename";
  73. return;
  74. }
  75. $attributes->{rel} = 'stylesheet';
  76. $attributes->{type} = 'text/css';
  77. $attributes->{href} = $url;
  78. return $self->_tag('link', $attributes);
  79. }
  80. =head2 url
  81. Returns the URL for the given file
  82. [% Asset.url('css/datatables.css') %]
  83. =cut
  84. sub url {
  85. my ( $self, $filename ) = @_;
  86. my $stash = $self->{_CONTEXT}->stash();
  87. my $interface = $stash->get('interface');
  88. my $theme = $stash->get('theme');
  89. my $configkey = $interface =~ /opac/ ? 'opachtdocs' : 'intrahtdocs';
  90. my $root = C4::Context->config($configkey);
  91. my ($basename, $dirname, $suffix) = fileparse($filename, qr/\.[^.]*/);
  92. my $type = substr $suffix, 1;
  93. my @dirs = (
  94. "$theme",
  95. ".",
  96. );
  97. my $version = Koha::version;
  98. $version =~ s/([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/$1.$2$3$4/;
  99. foreach my $dir (@dirs) {
  100. my $abspath = File::Spec->catfile($root, $dir, $filename);
  101. if (-e $abspath) {
  102. return File::Spec->catfile($interface, $dir, $dirname, "${basename}_${version}${suffix}");
  103. }
  104. }
  105. }
  106. =head2 _tag
  107. Returns an HTML tag with given name and attributes.
  108. This shouldn't be used directly.
  109. =cut
  110. sub _tag {
  111. my ($self, $name, $attributes) = @_;
  112. my @attributes_strs;
  113. if ($attributes) {
  114. while (my ($key, $value) = each %$attributes) {
  115. push @attributes_strs, qq{$key="$value"};
  116. }
  117. }
  118. my $attributes_str = join ' ', @attributes_strs;
  119. return "<$name $attributes_str>";
  120. }
  121. 1;