@@ -, +, @@ ---------- -- Add tests should pass --- t/db_dependent/www/help.t | 131 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) create mode 100644 t/db_dependent/www/help.t --- a/t/db_dependent/www/help.t +++ a/t/db_dependent/www/help.t @@ -0,0 +1,131 @@ +#!/usr/bin/perl + +# This file is part of Koha. +# +# Copyright (C) 2018 Mark Tompsett +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +use utf8; +use XML::Simple; +use Encode; +use Cwd; +use List::MoreUtils qw/any/; +use English qw/ -no_match_vars /; +use File::Find; +use File::Basename; +use Carp qw/croak/; + +use Test::More; +use Test::WWW::Mechanize; + +my $koha_conf = $ENV{KOHA_CONF}; +my $xml = XMLin($koha_conf); + +my $user = $ENV{KOHA_USER} || $xml->{config}->{user}; +my $password = $ENV{KOHA_PASS} || $xml->{config}->{pass}; +my $intranet = $ENV{KOHA_INTRANET_URL}; + +eval { use C4::Context }; +if ($EVAL_ERROR) { + plan skip_all => "Tests skip. You must have a working Context\n"; +} +elsif ( not defined $intranet ) { + plan skip_all => + "Tests skip. You must set env. variable KOHA_INTRANET_URL to do tests\n"; +} + +# Determine the source_code_directory +my $source_code_dir = $PROGRAM_NAME; +$source_code_dir =~ s/t\/db_dependent\/www\/help.t//gxsm; +$source_code_dir .= q{.}; +my @directories; +push @directories, $source_code_dir; + +# Determine all the files to scrape. +my @url_pieces; +finddepth( \&wanted, @directories ); + +sub wanted { + my $filename = $File::Find::name; + + # If it is a help template file... + if ( $filename =~ /help\/(.*)tt$/xsm ) { + my $url_piece = $1; + $url_piece .= q{pl}; + + # and it has 'full documentation' in it, then + # it has a link to the manual in it. + if ( file_has_helplink($filename) ) { + push @url_pieces, $url_piece; + } + } + return; +} + +sub file_has_helplink { + my ($file_name) = @_; + + open my $fh, '<', + basename($file_name) || croak "Can't open file $file_name"; + my @file_contents = <$fh>; + close $fh; + if ( any { /full documentation/ } @file_contents ) { + return 1; + } + else { + return 0; + } +} + +# The only exception is 'nohelp'. +push @url_pieces, 'nohelp.pl'; +my @sorted_url_pieces = sort @url_pieces; + +$intranet =~ s/\/$//xsm; + +my $agent = Test::WWW::Mechanize->new( autocheck => 1 ); + +# For all the files which have manual links... +foreach my $url_part (@sorted_url_pieces) { + + # Build the url. + my $test_url = "$intranet/cgi-bin/koha/$url_part"; + + # Grab the page. + $agent->get_ok("$intranet/cgi-bin/koha/help.pl?url=$test_url"); + + # Scrape it for the manual URL + my $page = $agent->content(); + my $current_help_url = $page; + if ( $url_part !~ /nohelp/xsm + && $current_help_url =~ /full documentation(.*)/xsm ) + { + $current_help_url = $1; + } + elsif ( $url_part =~ /nohelp/xsm && $current_help_url =~ /Sorry(.*)/xsm ) { + $current_help_url = $1; + } + if ( $current_help_url =~ /href="(.*?)">(.*?)manual/xm ) { + $current_help_url = $1; + } + $current_help_url =~ s/17.11/18.05/gxsm; + + # Make sure the manual page loads. + $agent->get_ok($current_help_url); +} + +done_testing(); --