Koha/App/Intranet.pm

   1 package Koha::App::Intranet;
   2
   3 # Copyright 2020 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 use Modern::Perl;
  21
  22 use Mojo::Base 'Mojolicious';
  23
  24 use Koha::Caches;
  25 use Koha::Cache::Memory::Lite;
  26
  27 sub startup {
  28     my ($self) = @_;
  29
  30     push @{$self->plugins->namespaces}, 'Koha::App::Plugin';
  31     push @{$self->static->paths}, $self->home->rel_file('koha-tmpl');
  32
  33     # Create route for all CGI scripts, need to be loaded first because of
  34     # CGI::Compile
  35     $self->plugin('CGIBinKoha');
  36
  37     # Create routes for API
  38     # FIXME This generates routes like this: /api/api/v1/...
  39     $self->plugin('RESTV1');
  40
  41     $self->hook(before_dispatch => \&_before_dispatch);
  42     $self->hook(around_action => \&_around_action);
  43
  44     my $r = $self->routes;
  45
  46     $r->any('/')->to(cb => sub { shift->redirect_to('/cgi-bin/koha/mainpage.pl') });
  47 }
  48
  49 sub _before_dispatch {
  50     my $c = shift;
  51
  52     my $path = $c->req->url->path->to_string;
  53
  54     # Remove Koha version from URL
  55     $path =~ s/_\d{2}\.\d{7}\.(js|css)/.$1/;
  56
  57     # See FIXME above
  58     if ($path =~ m|^/api/v|) {
  59         $path = '/api' . $path;
  60     }
  61
  62     $c->req->url->path->parse($path);
  63 }
  64
  65 sub _around_action {
  66     my ($next, $c, $action, $last) = @_;
  67
  68     # Flush memory caches before every request
  69     my $caches = $Koha::Caches::singleton_caches;
  70     if ($caches) {
  71         foreach my $key (keys %$caches) {
  72             my $cache = $caches->{$key};
  73             if (ref $cache->{cache} eq 'Cache::Memory') {
  74                 $cache->flush_all;
  75             }
  76             $cache->flush_L1_cache;
  77         }
  78     }
  79     $Koha::Caches::singleton_caches = {};
  80     Koha::Cache::Memory::Lite->flush();
  81
  82     return $next->();
  83 }
  84
  85 1;