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

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

Return to bug 20706