View | Details | Raw Unified | Return to bug 20706
Collapse All | Expand All

(-)a/t/db_dependent/www/help.t (-1 / +131 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright (C) 2018   Mark Tompsett
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 utf8;
23
use XML::Simple;
24
use Encode;
25
use Cwd;
26
use List::MoreUtils qw/any/;
27
use English qw/ -no_match_vars /;
28
use File::Find;
29
use File::Basename;
30
use Carp qw/croak/;
31
32
use Test::More;
33
use Test::WWW::Mechanize;
34
35
my $koha_conf = $ENV{KOHA_CONF};
36
my $xml       = XMLin($koha_conf);
37
38
my $user     = $ENV{KOHA_USER} || $xml->{config}->{user};
39
my $password = $ENV{KOHA_PASS} || $xml->{config}->{pass};
40
my $intranet = $ENV{KOHA_INTRANET_URL};
41
42
eval { use C4::Context };
43
if ($EVAL_ERROR) {
44
    plan skip_all => "Tests skip. You must have a working Context\n";
45
}
46
elsif ( not defined $intranet ) {
47
    plan skip_all =>
48
      "Tests skip. You must set env. variable KOHA_INTRANET_URL to do tests\n";
49
}
50
51
# Determine the source_code_directory
52
my $source_code_dir = $PROGRAM_NAME;
53
$source_code_dir =~ s/t\/db_dependent\/www\/help.t//gxsm;
54
$source_code_dir .= q{.};
55
my @directories;
56
push @directories, $source_code_dir;
57
58
# Determine all the files to scrape.
59
my @url_pieces;
60
finddepth( \&wanted, @directories );
61
62
sub wanted {
63
    my $filename = $File::Find::name;
64
65
    # If it is a help template file...
66
    if ( $filename =~ /help\/(.*)tt$/xsm ) {
67
        my $url_piece = $1;
68
        $url_piece .= q{pl};
69
70
        # and it has 'full documentation' in it, then
71
        # it has a link to the manual in it.
72
        if ( file_has_helplink($filename) ) {
73
            push @url_pieces, $url_piece;
74
        }
75
    }
76
    return;
77
}
78
79
sub file_has_helplink {
80
    my ($file_name) = @_;
81
82
    open my $fh, '<',
83
      basename($file_name) || croak "Can't open file $file_name";
84
    my @file_contents = <$fh>;
85
    close $fh;
86
    if ( any { /full documentation/ } @file_contents ) {
87
        return 1;
88
    }
89
    else {
90
        return 0;
91
    }
92
}
93
94
# The only exception is 'nohelp'.
95
push @url_pieces, 'nohelp.pl';
96
my @sorted_url_pieces = sort @url_pieces;
97
98
$intranet =~ s/\/$//xsm;
99
100
my $agent = Test::WWW::Mechanize->new( autocheck => 1 );
101
102
# For all the files which have manual links...
103
foreach my $url_part (@sorted_url_pieces) {
104
105
    # Build the url.
106
    my $test_url = "$intranet/cgi-bin/koha/$url_part";
107
108
    # Grab the page.
109
    $agent->get_ok("$intranet/cgi-bin/koha/help.pl?url=$test_url");
110
111
    # Scrape it for the manual URL
112
    my $page             = $agent->content();
113
    my $current_help_url = $page;
114
    if (   $url_part !~ /nohelp/xsm
115
        && $current_help_url =~ /full documentation(.*)/xsm )
116
    {
117
        $current_help_url = $1;
118
    }
119
    elsif ( $url_part =~ /nohelp/xsm && $current_help_url =~ /Sorry(.*)/xsm ) {
120
        $current_help_url = $1;
121
    }
122
    if ( $current_help_url =~ /href="(.*?)">(.*?)manual/xm ) {
123
        $current_help_url = $1;
124
    }
125
    $current_help_url =~ s/17.11/18.05/gxsm;
126
127
    # Make sure the manual page loads.
128
    $agent->get_ok($current_help_url);
129
}
130
131
done_testing();

Return to bug 20706