#! /usr/bin/perl -w
# Selima Website Content Management System
# urlcheck: The URL validator.

#  Copyright (c) 2004-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2004-11-06

use 5.008;
use strict;
use warnings;
use threads;
use threads::shared;
# Prototype declaration
sub main();
sub check_urls();
sub check_urls_nonthread();
sub check_urls_in_a_thread();
sub is_reachable($);

use Config qw(%Config);
use LWP::UserAgent;
use Net::Telnet;
use URI;

our ($CURINDEX, @URLS) : shared;
$CURINDEX = 0;
@URLS = qw();


main;
exit 0;

sub main() {
    local ($_, %_);
    
    @URLS = <STDIN>;
    chomp foreach @URLS;
    check_urls;
    print join "", map "$_\n", @URLS;
    
    return;
}

# check_urls: Proform URL checks (with threading)
sub check_urls() {
    local ($_, %_);
    # Run check_urls_nonthread() if ithread is not available
    return check_urls_nonthread
        if !defined $Config{"useithreads"};
    # Start the thread workers
    for ($_ = 0, @_ = qw(); $_ < 10; $_++) {
        push @_, threads->new(\&check_urls_in_a_thread)
    }
    # Wait for everyone to end
    $_->join foreach @_;
    # Return the result
    return;
}

# check_urls_nonthread: Proform URL checks without threading
sub check_urls_nonthread() {
    local ($_, %_);
    @URLS = map is_reachable($_), @URLS;
    return;
}

# check_urls_in_a_thread: Proform URL checks in a thread
sub check_urls_in_a_thread() {
    local ($_, %_);
    # Check until the end
    while (($_ = $CURINDEX++) < @URLS) {
        $URLS[$_] = is_reachable($URLS[$_]);
    }
    return;
}

# is_reachable: Check if the target of an URL is reachable
sub is_reachable($) {
    local ($_, %_);
    my ($uri, $UA, $r);
    $_ = $_[0];
    # Check if it is available
    # LWP::UserAgent cannot handle telnet.  We check it with Net::Telnet.
    if (/^telnet:\/\//) {
        $uri = new URI($_);
        %_ = (
            Host    => $uri->host,
            Port    => $uri->port,
        );
        eval { new Net::Telnet(%_) };
        return ($@ eq ""? 1: 0);
    
    # Use LWP::UserAgent
    } else {
        $UA = new LWP::UserAgent;
        $UA->timeout(20);
        $r = $UA->get($_);
        return (!$r->is_error? 1: 0);
    }
}