Koha/Template/Plugin/Asset.pm

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