#!/perl -w
# NAME: chklink.pl
# AIM: Develop a method to CHECK a URL link ...
# 2010/04/19 - some minor tidying only...
# 23/08/2007 geoff mclane geoffair.net/mperl
use strict;
use warnings;
use Socket;
use LWP::Simple;
unshift(@INC, 'C:/GTools/perl');
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
	my @tmpsp = split(/\\/,$pgmname);
	$pgmname = $tmpsp[-1];
}
my $perl_root = 'C:/GTools/perl';
my $outfile = $perl_root."\\temp.$pgmname.txt";
open_log($outfile);
prt( "$0 ... Check links...\n" );

# features
my $do_data_fetch = 0;

### debug
my $dbg3 = 1;	# show resolved IP addresses

my @urls_org = qw( http://babelfish.altavista.com/ http://www.geoffmclane.com/fg/
http://www.colorcombo.com/array.html http://help.godaddy.com/index.php?
http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=6ar=IStart );

# note: seems http://sourceforge.net/projects/giflib/files/ took over from 
# http://prdownloads.sourceforge.net/libungif/libungif-4.1.3.tar.gz below.
my @urls = qw( http://prdownloads.sourceforge.net/freetype/ft219.zip
ftp://ftp.remotesensing.org/pub/gdal/gdal126.zip
http://www.xmission.com/~nate/glut/glut-3.7.6-src.zip
ftp://ftp.simtel.net/pub/simtelnet/msdos/graphics/jpegsr6.zip
http://prdownloads.sourceforge.net/libungif/libungif-4.1.3.tar.gz
ftp://swrinde.nde.swri.edu/pub/png/src/lpng128.zip
ftp://ftp.remotesensing.org/pub/proj/proj-4.4.9.zip
ftp://ftp.remotesensing.org/pub/libtiff/tiff-3.7.2.zip
http://www.zlib.net/zlib122.zip );

###my $url = 'http://babelfish.altavista.com/';
###my $url = 'http://www.geoffmclane.com/fg/';
###my $url = 'http://www.colorcombo.com/array.html';
###my $url = 'http://help.godaddy.com/index.php?';
my $url = 'http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=6ar=IStart';

sub Get_Host_Name($) {
	my ($nm) = shift;
	if ($nm =~ /^http:\/\/(.*)/i) {
		$nm = $1;
	} elsif ($nm =~ /^https:\/\/(.*)/i) {
		$nm = $1;
	} elsif ($nm =~ /^ftp:\/\/(.*)/i) {
		$nm = $1;
	}
    #elsif ($nm =~ /^(\w+):\/\/(.*)$/)
    #    $nm = $2;
    #}
	my @arr = split('/', $nm);
	$nm = $arr[0];
	return $nm;
}

sub Get_Domain_Name($) {
	my ($nm) = shift;
	$nm = Get_Host_Name($nm);
	if ($nm =~ /^www\.(.*)/) {
		$nm = substr($nm,4);
	}
	return $nm;
}

sub Get_URL_Text_Count($) {
	my ($url) = shift;
	my $txt = get( $url );
	my $tcnt = 0;
	$tcnt =	length($txt) if ($txt);
	return $tcnt;
}

############################################################
# Show IP Address
# uses sockets, gethostbyname
# Return 0, if can NOT be resolved.
# else the number of IP addresses resolved.
############################################################
sub showIPAddress($) {
	my ($nm) = shift;
	my $hnm = Get_Host_Name($nm);
	my @addr = gethostbyname($hnm);
	my $cnt = 0;
	if( !@addr ) {
		prt( "Can't resolve [$nm]($hnm): error: $!\n" );
		return 0;
	}
	@addr = map { inet_ntoa($_) } @addr[4 .. $#addr];
	foreach my $k (@addr) {
		$cnt++;
		prt( "$cnt: [$nm] (domain=[$hnm]) resolves to IP [$k]\n" ) if ($dbg3);
	}
	return $cnt;
}



sub process_url_list($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    prt("Got $max URLS to process...\n");
    my $cnt = 0;
    foreach my $u (@{$ra}) {
        $cnt++;
        prt("\n$cnt of $max: [$u]\n");
        showIPAddress( $u );
        if ($do_data_fetch) {
            my $tc = Get_URL_Text_Count($u);
            if ($tc) {
                prt( "Got $tc chars from [$u] ...\n" );
            } else {
                prt( "FAILED **** get on [$u] ...\n" );
            }
        }
	}
}

#showIPAddress( $url );
#my $tc = Get_URL_Text_Count($url);
#if ($tc) {
#	prt( "Got $tc chars from [$url] ...\n" );
#} else {
#	prt( "FAILED get on [$url] ...\n" );
#}

process_url_list( \@urls );

close_log($outfile,1);
exit(0);

#################################


# eof - chklink.pl
