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
  52 =head1 FUNCTIONS
  53
  54 =head2 new
  55
  56 Constructor. Do not use this directly.
  57
  58 =cut
  59
  60 sub new {
  61     my ($class, $context) = @_;
  62
  63     my $self = {
  64         _CONTEXT => $context,
  65     };
  66
  67     return bless $self, $class;
  68 }
  69
  70 =head2 js
  71
  72 Returns a <script> tag for the given JS file
  73
  74     [% Asset.js('js/datatables.js') %]
  75
  76 =cut
  77
  78 sub js {
  79     my ( $self, $filename, $attributes ) = @_;
  80
  81     my $url = $self->url($filename);
  82     unless ($url) {
  83         warn "File not found : $filename";
  84         return;
  85     }
  86
  87     $attributes->{src} = $url;
  88
  89     return $self->_tag('script', $attributes) . '</script>';
  90 }
  91
  92 =head2 css
  93
  94 Returns a <link> tag for the given CSS file
  95
  96     [% Asset.css('css/datatables.css') %]
  97     [% Asset.css('css/print.css', { media = "print" }) %]
  98
  99 =cut
 100
 101 sub css {
 102     my ( $self, $filename, $attributes ) = @_;
 103
 104     my $url = $self->url($filename);
 105     unless ($url) {
 106         warn "File not found : $filename";
 107         return;
 108     }
 109
 110     $attributes->{rel} = 'stylesheet';
 111     $attributes->{type} = 'text/css';
 112     $attributes->{href} = $url;
 113
 114     return $self->_tag('link', $attributes);
 115 }
 116
 117 =head2 url
 118
 119 Returns the URL for the given file
 120
 121     [% Asset.url('css/datatables.css') %]
 122
 123 =cut
 124
 125 sub url {
 126     my ( $self, $filename ) = @_;
 127
 128     my $stash = $self->{_CONTEXT}->stash();
 129     my $interface = $stash->get('interface');
 130     my $theme = $stash->get('theme');
 131
 132     my $configkey = $interface =~ /opac/ ? 'opachtdocs' : 'intrahtdocs';
 133     my $root = C4::Context->config($configkey);
 134
 135     my ($basename, $dirname, $suffix) = fileparse($filename, qr/\.[^.]*/);
 136
 137     my $type = substr $suffix, 1;
 138     my @dirs = (
 139         "$theme",
 140         ".",
 141     );
 142
 143     my $version = C4::Context->preference('Version');
 144     foreach my $dir (@dirs) {
 145         my $abspath = File::Spec->catfile($root, $dir, $filename);
 146         if (-e $abspath) {
 147             return File::Spec->catfile($interface, $dir, $dirname, "${basename}_${version}${suffix}");
 148         }
 149     }
 150 }
 151
 152 =head2 _tag
 153
 154 Returns an HTML tag with given name and attributes.
 155 This shouldn't be used directly.
 156
 157 =cut
 158
 159 sub _tag {
 160     my ($self, $name, $attributes) = @_;
 161
 162     my @attributes_strs;
 163     if ($attributes) {
 164         while (my ($key, $value) = each %$attributes) {
 165             push @attributes_strs, qq{$key="$value"};
 166         }
 167     }
 168     my $attributes_str = join ' ', @attributes_strs;
 169
 170     return "<$name $attributes_str>";
 171 }
 172
 173 1;