- 

#!/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 <http://www.gnu.org/licenses>.

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();