#!/usr/bin/perl
#
# OpenClient for SOAP XML interface of @Pel.Net Search
#
# Copyright (C) 2008  PelliX
#
# This program 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.
#
# This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
#
# service status is available in HTML at 
# - http://datacenter.pelnet.eu/search/status.asp
# you can also get an XML output of this info at
# - http://datacenter.pelnet.eu/SOAPSearch/Service.asmx/GetStatus
#
# Most of the development was conducted on Win32 (ActivePerl) and
# a Linux 2.6 Debian SMP system, running Xorg in 800x600. Threading 
# should not be a concern as far as I can tell, almost all the test environments 
# were equipped with multi-threaded Perl installations.
#
#  PelliX 2008
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
# Notes
#
# The @Pel.Net OpenSearch Client is designed to be interoperable across a 
# wide range of platforms. Hence that some parts, like the connection diag
# module and the option dialog box, are not designed to be pretty or even
# user friendly, but functional, regardless of present binaries and libraries
# on the client system. Instead of running `perl -w ./script.pl` from the command
# line, you can also add '-w' to the interpreter in line 1 of this file.
#
# According to the research that has been performed in regard to the 
# process of ensuring compatibility across multiple platforms, this application
# will (or should) run on the following Platforms/Operating Systems:
#
# Windows (16/32/64bit)(x86/x86_64)
# Windows NT 3.51
# Windows NT 4.0
# Windows 95 
# Windows 98
# Windows 98SE
# Windows ME
# Windows 2000
# Windows XP (incl 64bit)	-	XP SP2 32bit tested
# Windows Server 2003 (incl Itanium based)
# Windows Vista (incl 64bit)
# Windows PE 
#
# OS/2 Warp (> 3.x)
# AIX 3.x or higher (requires perl update)
# Solaris 2.x or higher (SPARC, x86 & x86_64)	-	Solaris 10/SPARC tested
# OS/400 (requires perl update)
# Linux 2.2 or higher (MIPS, Alpha, SPARC, ARM, x86, x86_64,PPC) 
# - 	2.6 i686 SMP Tested
# Minix
# Mac OS 8.1  or higher (PPC, Intel)
#
# Operating systems known NOT to work:
# VxWorks
# Inferno
# OS1100
# PalmOS 
# PRIMOS
#
# Dependancies:
# 
# Perl 5.1 or higher (this has not been confirmed, all testing and development has been
#			   performed with perl 5.6 and higher)
# Tk libraries (available from CPAN)
# Perl IO (available from CPAN)
# Data::Dumper (available from CPAN)
# SOAP::Lite  0.61 or higher(available from CPAN)
# 			  please note that we only tested 0.70 and 0.71
# LWP::UserAgent (available from CPAN)
# 
# OPTIONAL! (for Download Manager):
#
# Authen::NTLM (available from CPAN)
# Authen::NTLM::HTTP (available from CPAN)
#
# XML dependancies (for config files, not the SOAP interaction)
#
# XML::Writer (available from CPAN)
# XML::XPath (which depends on XML::Parser)
# XML::Parser (which depends on libexpat)
#
# The XML dependancies currently depend on a non-perl package, namely Expat. You must 
# download Expat from SourceForge and either install the Win32 binary, or compile from
# source. The exception to the rule is ActivePerl for Windows, which appears to either
# automatically have/substitute it, or installs it automagically in the background. In
# the event that you are unable to compile the Expat libraries, like on Solaris without
# some tweaking, you can comment the line `use XML::XPath;` in the main app. This means
# that you can _export_ valid XML files, but you cannot import them - thus you may also
# not have an XML configfile in any of the directories it searches in when loading the 
# app, because it will try to parse any valid files it finds.
#
#  Note that when running Linux, BSD, OS/400, AIX, Solaris, Minix and other *nix systems
#  you need X set up with a screen resolution of 800x600 or higher.
#  When running Windows you will obviously need a desktop, i.e. you cannot properly
#  use the application without a graphical interface (like over a Telnet connection).  
#  In theory one could debug the startup of the application with a console only.
#
# Help
# 
# Please see http://datacenter.pelnet.eu/support/topic.asp?TOPIC_ID=143 for more
# information on getting Tk (and Tcl) installed on Solaris 10, SPARC.
# 
# Please see http://datacenter.pelnet.eu/support/topic.asp?TOPIC_ID=145 for more
# information on getting Perl and Tk installed on OS/2 Warp 4.
#
# Bugs
#
# Bugs can be reported by sending an email to support@pel.net internally, or one can
# report the issue online first at http://pelnet.no-ip.org/?cat=support to file a service
# request, or if one is entirely sure that the issue has been confirmed, post the bug to
# http://datacenter.pelnet.eu/bugtrack.
#
#
# Main Dependancies
use Tk;
use Data::Dumper;

# XML dependancies
use IO::File;
use XML::Writer;
use XML::XPath;

use Tk::HList;
use Tk::DialogBox;
use Tk::LabEntry;
use Tk::NoteBook;
use Tk::ProgressBar;
use LWP::Simple;
use LWP::UserAgent;
# comment the next line for the LWP::UserAgent debug
#use LWP::Debug qw(+);
# remove the +trace=>'all'  syntax for a less verbose output
use SOAP::Lite;
#use SOAP::Lite +trace=>'all';
# diagnostics
use diagnostics;

# this will not work. uncomment and fix if desired.
#use strict;

# Download Manager Dependancies (not required for Win32, or other 
# Perl that does not support NTLM reliably)
use Authen::NTLM;
use Authen::NTLM::HTTP;

# warnings
$^W++; 
# Debug flag (will be overridden by the .ini file (if it exists) and check for syntax
my $DEBUG = 1;
my $SYNTAXCONFIG = 0;
my $CONFIGSPECIFIED = "";

# allow user to acknowledge that we have been launched
print "........\n\n".
		"#######################################\n".
		"#                                     #\n".
		"#  \@Pel.Net OpenSearch Client         #\n".
		"#                                     #\n".
		"#  build 1004 beta                    #\n".
		"#                                     #\n".
		"#######################################\n\n";

## main window
my $mw = new MainWindow(-height=>350,
						-width=>700);
my $f;

## Replace default (Active)(Perl) icon  (Win32/Linux-XFCE tested)
$mw->idletasks;
my $icon = $mw->Photo(-file => 'icon.gif');
$mw->iconimage($icon);

# check for new image
&image_check;

# check what we are running on
my $VERSION = 1004;
my $OS_TYPE = "unknown";
&os_check;

# Default configuration. These will be overwritten by
# "opensearch.ini" at startup, if it exists.
my $config = { HOST			=>  'datacenter.pelnet.eu',
               PORT 		=>	80,
			   DLOADDIR		=>	'',
			   DLOADP		=> 	'http',
               UAGENT 		=>  'OpenSearch Perl/Tk v1003(beta)',
               DEBUG		=>  1,
			   DEBUGFILE	=>	'startup.log',
			   LOGTOFILE	=>	0,
               CONFIGFILE	=>	'XML',
			   USEDM		=>	0,
			   USER			=>	'',
			   PWD			=>	''
			  };

# check syntax
&get_syntax;

# string array for loading/saving config options
my $localconfig;

# local array for diag results
my $diag_results = { 
					OSTYPE		=>  $OS_TYPE,
					PERLVER		=>  '',
					IPADDR 		=>  '',
					SERVICE		=>  '',
					STATUS		=>  '',
					MAINT		=>  ''
					};

###############
#  GUI                             #
###############
$mw->title("\@Pel.Net OpenSearch v1.004  -  Perl/Tk (beta)");
# bind keys to functions
$mw->bind('<F1>' => \&help_box);
$mw->bind('<F2>' => \&about_box);
$mw->bind('<F3>' => \&configuration);
$mw->bind('<F4>' => \&conn_test);
$mw->bind('<F5>' => \&SOAP_SearchFor);
$mw->bind('<F6>' => \&connectServer);

# first, the welcome message
$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
	-message=>"Thank you for using the OpenSearch Client!");

# then, the datagrid & default items
@items = (
		 ['   no', '       results'],
		 );
&create_datagrid($mw);

# grid approach
# -sticky => STYLE 	This option may be used to position (or stretch) the widget within its cell. STYLE is a string that contains zero or more of the characters n, s, e or w. Each letter refers to a side (north, south, east, or west) that the slave will "stick" to. If both n and s (or e and w) are specified, the slave will be stretched to fill the entire height (or width) of its cavity.
# -ipadx => AMOUNT 	The AMOUNT specifies how much horizontal internal padding to leave on each side of the slave(s). This is space is added inside the slave(s) border.
# -ipady => AMOUNT 	The AMOUNT specifies how much vertical internal padding to leave on each side of the slave(s). Options same as -ipadx
# -padx => AMOUNT 	The amount specifies how much horizontal external padding to leave on each side of the slave(s), in screen units. AMOUNT may be a list of two values to specify padding for left and right separately.
# -pady => AMOUNT 	The amount specifies how much vertical external padding to leave on the top and bottom of the slave(s), in screen units. Options same as -padx.
# -row => N 	Insert the slave so that it occupies the Nth row in the grid. Row numbers start with 0. If this option is not supplied, then the slave is arranged on the same row as the previous slave specified on this call to grid, or the first unoccupied row if this is the first slave.
# -column => N 	Insert the slave so that it occupies the N'th column in the grid. Options same as -row
# -rowspan => N 	Insert the slave so that it occupies N rows in the grid. The default is one row.
# -columnspan => N

# The following capitalized variables can be edited for testing purposes
my $TERMSTOQUERY = "uninitialized";

###########
# Main Loop        #
###########
#MainLoop();
MAIN: {
	# upper label
	my $lab = $mw -> Label(-text=>"Enter your desired search terms, select a database from the dropdown menu and hit Go.") -> grid(
				-sticky=>"nw",
				-padx=>1,-pady=>1,
				-ipadx=>1,-ipady=>1,
				-row=>1,-column=>1,-columnspan=>6);

	# searchbox
	$ent = $mw -> Entry() -> grid(-sticky=>"nwe",
				-padx=>5,-pady=>5,-ipadx=>2,-ipady=>2,
				-row=>2,-column=>1,-columnspan=>6);
	# make enter key do the same as clicking the search button
	$ent->bind('<Return>' => \&SOAP_SearchFor); 

	# buttons
	# menu
	my $var;
	$opt = $mw -> Optionmenu(-options => [qw(Select... ------)],
			-command => sub {
							$sectionselected = shift;
							# update variable for request
							$SECTIONTOQUERY = $sectionselected;
							print "select-$sectionselected\n";
							},
				-variable => \$var,
				)-> grid(
					-sticky=>"n",
					-padx=>2,-pady=>3,
					-row=>3,-column=>1,
					-columnspan=>2);
	# search
	my $searchbutton = $mw -> Button(-text => "Search\@Pel", 
				-width=>20,
				-command =>\&SOAP_SearchFor)
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>4,
					-row=>3,-column=>3,
					-columnspan=>2);
	# help
	my $helpbutton = $mw -> Button(-text => "Help",
				-command =>\&help_box)
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>4,
					-row=>3,-column=>5,
					-columnspan=>2);
	# progress
	my $progress = $mw->ProgressBar(
			-width => 20,
			-height=> 10,
			-length => 20,
			-anchor => 'w',
			-from => 0,
			-to => 100,
			-blocks => 10,
			-colors => [0, 'red', 50, 'yellow' , 80, 'green'],
			-variable => \$percent_done
			) -> grid(
				-sticky=>"nwe",
				-padx=>2,-pady=>4,	
				-row=>4,-column=>1,
				-columnspan=>2,
				-rowspan=>1);

	# results counter entry box
	my $resultslabel = $mw -> Label(-text => "Results",-width=>1) -> grid(
					-sticky=>"nwe",
					-padx=>2,-pady=>4,
					-row=>4,-column=>3,
					-columnspan=>1
					);
	$resultscountentry = $mw -> Entry() -> grid(
					-sticky=>"ne",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>4,
					-row=>4,-column=>4,
					#-columnspan=>1
					);

	# about
	my $aboutbutton = $mw -> Button(-text => "About \@PelSearch", 
				-command =>\&about_box)
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>2,
					-row=>4,-column=>5,
					-columnspan=>2);

	# Search Results label
	my $searchlabel = $mw -> Label(-text=>"Search Results:") -> grid(
				-sticky=>"nw",
				-row=>5,-column=>1,-columnspan=>2);

	# connect
	my $connectbutton = $mw -> Button(-text => "Connect", 
				-command =>\&connectServer) 
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>2,
					-row=>7,-column=>1,
					-columnspan=>2);
	# quit
	my $quitbutton = $mw -> Button(-text => "Quit",
				-width=>12,
				-command =>\&exitProgam) 
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>2,
					-row=>7,-column=>3);
	# Online Search
	my $onlinebutton = $mw -> Button(-text => "Configuration",
				#-width=>12,
				-command =>\&configuration) 
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>2,
					-row=>7,-column=>4);
	# conn test
	my $conntestbutton = $mw -> Button(-text => "Conn.Test",
				#-width=>12,
				-command =>\&conn_test) 
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>2,-pady=>2,
					-row=>7,-column=>5,
					-columnspan=>2);

	# Load Configuration
	my $loadbutton = $mw -> Button(-text => "Open Conf",
				#-width=>12,
				-command =>\&load_config) 
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>10,-pady=>2,
					-row=>7,-column=>8,
					-columnspan=>1);
	# Save Configuration
	my $savebutton = $mw -> Button(-text => "Save Conf",
				#-width=>12,
				-command =>\&save_config) 
					-> grid(-sticky=>"nwe",
					-ipadx=>1,-ipady=>1,
					-padx=>10,-pady=>2,
					-row=>7,-column=>7,
					-columnspan=>1);

	## Image
	$mw -> Photo('imggif', -file => "logo.gif");
	my $l = $mw->Label('-image' => 'imggif', -width=>316, -height=>118)->grid(-sticky=>"nwe",
				-padx=>4,-pady=>5,
				-ipadx=>4,-ipady=>5,
				-row=>1,-column=>7,-rowspan=>5,
				-columnspan=>2);

	# frame
	my $frm = $mw -> Frame(-height=>300,-relief=>"sunken");
	#$frm -> pack();
	my $testlabel = $frm -> Label(-text=>"...(re)loading datagrid...") -> pack;
	
	# build datagrid
	&create_datagrid($mw);

	$frm -> grid(-sticky=>"nwse",
				-row=>6,-column=>1,
				-columnspan=>7,
				-rowspan=>1,
				-padx=>4,-pady=>5);
	$frm -> configure (-height=>700, -width=>250);

		my $cfiletype = "";
		# Attempt to load the opensearch.ini configuration file
		my $file = "opensearch.ini";
		my $unixfile = "/etc/opensearch/".$file;
		my $unixhomefile = "$ENV{HOME}/.opensearch/".$file;
		# variables for loading the XML config file, if present
		my $xmlfile = "opensearch.xml";
		my $unixxmlfile = "/etc/opensearch/".$xmlfile;
		my $unixhomexmlfile = "$ENV{HOME}/.opensearch/".$xmlfile;
		$config->{CONFIGFILE} = "plain";
		if (-e $unixhomefile && $SYNTAXCONFIG == 0)
			{
			$cfiletype = "plain";
			print "loading-configfile\n";
			read_config($unixhomefile, $cfiletype);
			}
			elsif (-e $unixfile && $SYNTAXCONFIG == 0)
			{
			$cfiletype = "plain";
			print "loading-configfile\n";
			read_config($unixfile, $cfiletype);
			}
			elsif (-e $file && $SYNTAXCONFIG == 0)
			{
			$cfiletype = "plain";
			print "loading-configfile\n";
			read_config($file, $cfiletype);
			}
			else
			{
			print "no-plain-configfile\n";
			}
		# currently, the plain file will be loaded if the XML file is present, too, but the XML will override it.
		$config->{CONFIGFILE} = "XML";
		if (-e $unixhomexmlfile && $SYNTAXCONFIG == 0)
			{
			$cfiletype = "XML";
			print "loading-xml-configfile\n";
			read_config($unixhomexmlfile, $cfiletype);
			}
			elsif (-e $unixxmlfile && $SYNTAXCONFIG == 0)
			{
			$cfiletype = "XML";
			print "loading-xml-configfile\n";
			read_config($unixxmlfile, $cfiletype);
			}
			elsif (-e $xmlfile && $SYNTAXCONFIG == 0)
			{
			$cfiletype = "XML";
			print "loading-xml-configfile\n";
			read_config($xmlfile, $cfiletype);
			}
			else
			{
			print "no-xml-configfile\n";
			}

		# in case a config was specified on the command line
		if ($SYNTAXCONFIG == 1)
			{
			print "config-override\n";
			read_config($CONFIGSPECIFIED, "XML")
			}

		# SOAP::Lite and LWP::UserAgent debug
		if(($config->{DEBUG}) eq "1")
			{
			print "enabling-debug\n";
			#my $debugitem0 = "LWP::Debug qw(+)";
			#my $debugitem1 = "SOAP::Lite +trace=>'all'";
			# enable SOAP and LWP in depth debugging
			#my $module0 = $_[0];
			#my $module1 = $_[1];
			#use if($config->{DEBUG} eq "1"), $module0;
			#use if($config->{DEBUG} eq "1"), $module1
			}

		# this is a fix for the fact that the [X] button in the WindowManager will not kill the main loop.
		$mw->protocol('WM_DELETE_WINDOW', sub{});
		while (1)
			{
			eval MainLoop();
			}
		# not used... but all scripts should have an exit. I know I read that somewhere... 
		exit;
	}

##############
# Subroutines     #
##############
sub exitProgam 
	{
	print "exit-clicked\n";
 	$mw->messageBox(-title=>"Exit", 
		-message=>"Thank you for using the OpenSearch Client!");
	exit();
	}

sub connectServer
	{
	print "connecting-server\n";
	&SOAP_ListCat;
	return;
	}

# push button
sub push_button 
	{
	print "test-button-clicked\n";
	$mw->messageBox(-title=>"You...",
		-message=>"...pressed a button!");
		$ent -> insert(0,"Hello ");
	}

# get string variable from menu(click()
sub menu_input
	{
	print "menu-clicked\n";
	# currently unused
	}

# About info box
sub about_box 
	{
	print "about-clicked\n";
	$mw->messageBox(-title=>"About OpenSearch \@Pel.Net",
		-message=>"--== \@Pel.Net Software Dept ==-- \n" .
							" ----------------------- \n" .
							"\@Pel.Net OpenSearch v1 \n\n" .
							"build: 1003 beta(or compatible) \n" .
							"type : Ariel \n" .
							"time : October 2008.");
	}

# Help info box
sub help_box 
	{
	print "help-clicked\n";
	$mw->messageBox(-title=>"OpenSearch \@Pel.Net",
		-message=>"--== \@Pel.Net OpenSource Software (LGPL/GPL) ==--    \n" .
							" ----------------------- \n" .
							"\@Pel.Net Search Help \n\n" .
							"To perform a search, please enter the desired search\n" .
							"terms in the SearchBar at the top of the main window,\n" .
							"select a storage section from the pull-down menu\n" .
							"underneath and click the Search\@Pel button. \n\n" .
							"For more info on search syntaxing and the location of \n" .
							"certain data within the storage databases, please visit \n" .
							"one of the links in the top right of the main window. \n\n" .
							"Please note that the Win32 build of Search\@Pel does not \n" .
							"entirely accept the syntaxing that can be used with the \n" .
							"online version (Online Search). \n \n" .
							"You can also copy and paste the (partial) URL from the \n" .
							"Datagrid View to use in a webbrowser.\n");
	}

# count results and update 'Entry() #2'
sub result_count
	{
	$intResCount = $_[0];
	$resultscountentry->delete(0,'end');
	# update the 'entry' box
	$resultscountentry->insert(0, $intResCount);
	}

# progress bar update subroutine
sub progress_bar
	{
	my $intProgress = $_[0];
	$percent_done = $intProgress;
	}

# Get command line syntax(es)
sub get_syntax
	{
	# valid syntaxes
	my $configfile = "--config=";
	my $updatenow = "--update";
	my $help = "--help";
	my $syntax = "";
	# get every syntax given to the script. 
	my $i = 0;
	while($i < $#ARGV || $i == $#ARGV)
		{
		my $argument = $ARGV[$i];
		# work out which syntax that was
		if ($argument eq $updatenow || $configfile eq (substr($argument, 0, 9)) || $argument eq $help)
			{
			if($argument eq $updatenow)
				{
				&check_update;
				}
			if((substr($argument, 0, 9)) eq $configfile)
				{
				# override default loading scheme
				$SYNTAXCONFIG = 1;
				$syntax = $argument;
				$argument = (substr($argument, 0, 9));
				$syntax =~ s/--config=//gi;
				# set the desired configfile
				$CONFIGSPECIFIED = $syntax;
				print "ARGUMENT: $argument SYNTAX: $syntax \n\n";
				}
			if($argument eq $help)
				{
				print "\n\n   \@Pel OpenSearchClient build $VERSION\n\n";
				print " valid syntaxes are: \n\n";
				print " --help           :  prints this message. \n";
				print " --update         :  checks server for updates and retrieves \n" .
					  "                     them if they are marked as stable. \n";
				print " --config=[file]  :  specify config file in non-standard dir. \n\n";
				# if --help was called, then die
				exit;
				}
			}
		$i++;
		}
	}

# check for a new image online
sub image_check
	{
	my $agent = $config->{UAGENT};
	my $url = "http://datacenter.pelnet.eu/opensearch/logo.gif";
	my $filename = "opensearch.gif";
	my $ua = new LWP::UserAgent;
	$ua->timeout(10);
	$ua->agent($agent);
	my $req = new HTTP::Request 'GET',$url;
	# send the request
	$res = $ua->request($req);
	if ($res->is_success) 
		{
		print "updating-image\n";
		getstore($url, 'logo.gif') or
			die ("retrieve-failed\n");
		}
		else
		{
		print "image-uptodate\n";
		}
	return;
	}

# OS check
sub os_check
	{
	# this could have been done by checking the details of the Perl
	# installation on the machine, but as I don't know what 'package
	# managed' versions of Perl report from OS/400, AIX, etc this
	# check is easier to implement.
	if (-e '/bin/')
		{
		print "identifying-as UNIX\n";
		$OS_TYPE = "Unix/Linux";
		my $kernel = `uname -a`;
		my $version = `uname -r`;
		# Solaris
		my $solaris = `uname -a | grep sun4u`;
			$solaris = $solaris.`uname -a | grep SunOS`;
		# Linux/GNU
		my $linux = `uname -a | grep Linux`;
			$linux = $linux.`uname -a | grep GNU`;
		# BSD
		my $bsd = `uname -a | grep BSD`;
		# AIX
		my $aix = `uname -a | grep AIX`;
		# OS/400
		my $os400 = `perl -V | grep "OS/400"`;
		# Mac OS X
		my $macos = `uname -a | grep Darwin`;
			$macos = `uname -a | grep Apple`;
		if ((length($solaris)) > 1)
			{
			$OS_TYPE = "SunOS".$version;
			print "Sys-type $OS_TYPE\n";
			}
		if ((length($linux)) > 1)
			{
			$OS_TYPE = "Linux".$version;
			print "Sys-type $OS_TYPE\n";
			}
		if ((length($bsd)) > 1)
			{
			$OS_TYPE = "BSD".$version;
			print "Sys-type $OS_TYPE\n";
			}
		if ((length($aix)) > 1)
			{
			$OS_TYPE = "AIX".$version;
			print "Sys-type $OS_TYPE\n";
			}
		if ((length($os400)) > 1)
			{
			$OS_TYPE = "IBM OS/400";
			print "Sys-type $OS_TYPE\n";
			}
		if ((length($macos)) > 1)
			{
			$OS_TYPE = "Mac OS X";
			print "Sys-type $OS_TYPE\n";
			}
		}
	if (-e 'C:' || -e 'D:' || -e 'A:')
		{
		# check for Windows
		my $winver = `ver | find "Windows"`;
			$winver =~ s/Microsoft//gi;
			$winver =~ s/^\s+//; #remove leading spaces
			$winver =~ s/\s+$//; #remove trailing spaces
		# check for OS/2
		my $os2ver = `ver | find "/2"`;
			$os2ver =~ s/^\s+//; #remove leading spaces
			$os2ver =~ s/\s+$//; #remove trailing spaces
		if ((length($winver)) > 2 || $ENV{SYSTEMDRIVE})
			{
			print "identifying-as WINDOWS\n";
			$OS_TYPE = "Win32"."-".$winver;
			print "Sys-type $OS_TYPE\n";
			}
			elsif ((length($os2ver)) > 2)
			{
			print "identifying-as OS/2\n";
			$OS_TYPE = "OS/2";
			print "Sys-type $OS_TYPE\n";
			}
		}
	return;
	}

# update checker
sub check_update
	{
	#debug($config)
	print "checking-updates\n";
	my @web;
	$web[0] = 'BuildInfo';

	my $SOAPClient = SOAP::Lite
		->uri('urn:SOAPSearch/')
		->proxy($url = $config->{DLOADP}."://".($config->{HOST}).":".$config->{PORT}."/SOAPSearch/Service.asmx")
		->on_action(sub{
						sprintf '%s%s', @_ 
#						})
#		->on_debug(sub{
#						print @_
						});
	my $result = $SOAPClient->BuildInfo(
			SOAP::Data->name('BuildInfo')
			->value(SOAP::Data->value(\@web)));

	# print the values retrieved from the SOAP request
	my $online_ver = $result->valueof('//BuildVer');
	my $state = $result->valueof('//State');
	my $codename = $result->valueof('//CodeName');
	my $useragent = $result->valueof('//UserAgent');
	my $clientip = $result->valueof('//ClientIP');
	print "Version Online:    ".$online_ver."\n";
	print "Current Status:    ".$state."\n";
	print "Build CodeName:    ".$codename."\n";
	print "User Agent Str:    ".$useragent."\n";
	print "Client IP Addr:    ".$clientip."\n";
	
	# check whether to alert about update
	if ($online_ver > $VERSION)
		{
		print "update-available\n";
		debug(FOUNDUPDATE);
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'info',
			-message=>"Update\n" .
						"\nAn update has been found! :\n" .
						"\nClient Version $online_ver, currently marked as $state\n" .
						"is available. You have been identified as $clientip \n" .
						"and have been granted access to the required files.");

		if ($state eq "stable")
			{
			# get the new version as archive
			my $agent = $config->{UAGENT};
			my $url = "http://datacenter.pelnet.eu/opensearch/client/v".$online_ver."/OpenSearchClient.rar";
			my $filename = "opensearch.gif";
			my $ua = new LWP::UserAgent;
			$ua->timeout(10);
			$ua->agent($agent);
			my $req = new HTTP::Request 'GET',$url;
			# send the request
			$res = $ua->request($req);
			if ($res->is_success) 
				{
				print "retrieving-update\n";
				getstore($url, 'OpenSearchClient.rar') or
					die ("retrieve-failed\n");
				}
				else
				{
				print "update-download-error\n";
				}
			if (-e 'OpenSearchClient.rar')
				{
				$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
				-icon=>'info',
				-message=>"Update\n" .
							"\nClient Version $online_ver has been retrieved.\n" .
							"You can find it in the directory from where the main\n" .
							"application was just launched.");
				}
			}
			else
			{
			print "unstable-build-detected\n";
			}
		}
	return;
	}

# Connection Test
sub conn_test
	{
	print "conntest-clicked\n";
	if((length($config->{DLOADP})) < 2 || (length($config->{HOST})) < 2 || (length($config->{PORT})) < 1 || ($config->{PORT}) eq "0")
		{
		# pop up generic error message box
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'error',
			-message=>"An error has occured!\n\n" .
						"Invalid Download Protocol, Host \n" .
						"or Port directives in config. \n");
		}
		else
		{
		# Copy all the configuration items to a local array
		foreach (keys %$diag_results) 
			{
			$statresults->{$_} = $diag_results->{$_};
			debug ($_);
			}

		if (not defined $g) 
			{
			$g = $mw->DialogBox(-title => "Connection Test", 
						-buttons => ["OK", "Run", "Cancel"]);
			$g->iconimage($icon);
			$o = $g->add('NoteBook', -ipadx=>6, -ipady=>6);
				my $diag_p = $o->add("login", -label => "Diag Connection",
												-underline => 0);
			
			$diag_p->LabEntry(-label => "OS Type:              ",
				 -labelPack => [-side => "left", -anchor => "w"],
				 -width => 20,
					-textvariable => \$OS_TYPE)->
					#-textvariable => \$diag_results->{OSTYPE})-> 
					pack(-side => "top", -anchor => "ne");
			
			$diag_p->LabEntry(-label => "Perl Version:         ",
				 -labelPack => [-side => "left", -anchor => "w"],
				 -width => 20,
					-textvariable => \$statresults->{PERLVER})-> 
					pack(-side => "top", -anchor => "ne");

			$diag_p->LabEntry(-label => "Local IP:             ",
				 -labelPack => [-side => "left", -anchor => "w"],
				 -width => 20,
					-textvariable => \$statresults->{IPADDR})->
					pack(-side => "top", -anchor => "ne");
					
			$diag_p->LabEntry(-label => "Public IP:            ",
				 -labelPack => [-side => "left", -anchor => "w"],
				 -width => 20,
					-textvariable => \$statresults->{PUBLICIP})->
					pack(-side => "top", -anchor => "ne");

			$diag_p->LabEntry(-label => "Service:              ",
				 -labelPack => [-side => "left", -anchor => "w"],
				 -width => 20,
					-textvariable => \$statresults->{SERVICE})->
					 pack(-side => "top", -anchor => "ne");

			$diag_p->LabEntry(-label => "Status:               ",
				 -labelPack => [-side => "left"],
				 -width => 20,
					 -textvariable => \$statresults->{STATUS})->
					 pack(-side => "top", -anchor => "ne");

			$diag_p->LabEntry(-label => "Maintenance:          ",
				 -labelPack => [-side => "left"],
				 -width => 20,
					 -textvariable => \$statresults->{MAINT})
					 ->pack(-side => "top", -anchor => "ne");

			$o->pack(-expand => "yes",
				 -fill => "both",
				 -padx => 5, -pady => 5,
				 -side => "top");
			}
		my $result2 = $g->Show;
		
		# actually try and do somthing with all o' this
		if ($result2 =~ /Run/) 
			{
			&get_status;
			&conn_test;
			}
		}
	}

# Config DialogBox
sub configuration
	{
	print "configuration-clicked\n";
#	my $localconfig;

	# Copy all the configuration items to a local array
	foreach (keys %$config) 
		{
		$localconfig->{$_} = $config->{$_};
		debug ($_);
		}
	
	if (not defined $f) 
		{
		$f = $mw->DialogBox(-title => "Configuration", 
					-buttons => ["OK", "Cancel"]);
		$f->iconimage($icon);
		$n = $f->add('NoteBook', -ipadx=>6, -ipady=>6);
			my $login_p = $n->add("login", -label => "Login",
											-underline => 0);
			my $host_p   = $n->add("host",  -label => "Connection",
											-underline => 0);
			my $dload_p   = $n->add("downloads",  -label => "Downloads",
											-underline => 0);
			my $advanced_p  = $n->add("proxy", -label => "Advanced",
											-underline => 0);
		
		$login_p->LabEntry(-label => "User:             ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 20,
				-textvariable => \$localconfig->{USER})-> 
				pack(-side => "top", -anchor => "nw");

		$login_p->LabEntry(-label => "Pwd:             ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 20, 
			 -show => '*',
				-textvariable => \$localconfig->{PWD})->
				pack(-side => "top", -anchor => "nw");

		$host_p->LabEntry(-label => "Host:             ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 50,
				 -textvariable => \$localconfig->{HOST})->
				 pack(-side => "top", -anchor => "nw");

		$host_p->LabEntry(-label => "Port:              ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 20,
				-textvariable => \$localconfig->{PORT})->
				 pack(-side => "top", -anchor => "nw");

		$dload_p->LabEntry(-label => "Download Folder:    ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 40,
				-textvariable => \$localconfig->{DLOADDIR})->
				 pack(-side => "top", -anchor => "nw");

		$dload_p->LabEntry(-label => "Use DownloadMgr:  ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 40,
				-textvariable => \$localconfig->{USEDM})->
				 pack(-side => "top", -anchor => "nw");

		$dload_p->LabEntry(-label => "Download Protocol: ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 40,
				-textvariable => \$localconfig->{DLOADP})->
				 pack(-side => "top", -anchor => "nw");

		$advanced_p->LabEntry(-label => "User Agent:    ",
			 -labelPack => [-side => "left"],
			 -width => 50,
				 -textvariable => \$localconfig->{UAGENT})->
				 pack(-side => "top", -anchor => "nw");

		$advanced_p->LabEntry(-label => "Debug :          ",
			 -labelPack => [-side => "left"],
			 -width => 20,
				 -textvariable => \$localconfig->{DEBUG})
				 ->pack(-side => "top", -anchor => "nw");
				 
		$advanced_p->LabEntry(-label => "DebugFile:      ",
			 -labelPack => [-side => "left"],
			 -width => 20,
				 -textvariable => \$localconfig->{DEBUGFILE})
				 ->pack(-side => "top", -anchor => "nw");

		$advanced_p->LabEntry(-label => "LogToFile:      ",
			 -labelPack => [-side => "left"],
			 -width => 20,
				 -textvariable => \$localconfig->{LOGTOFILE})
				 ->pack(-side => "top", -anchor => "nw");

		$advanced_p->LabEntry(-label => "ConfigType:    ",
			 -labelPack => [-side => "left"],
			 -width => 20,
				 -textvariable => \$localconfig->{CONFIGFILE})
				 ->pack(-side => "top", -anchor => "nw");

		$n->pack(-expand => "yes",
			 -fill => "both",
			 -padx => 5, -pady => 5,
			 -side => "top");
		}
	my $result = $f->Show;
	
	# actually try and do somthing with all o' this
	if ($result =~ /OK/) 
		{
		# Copy all the configuration items back
		foreach (keys %$config) 
			{
			$config->{$_} = $localconfig->{$_};
			}
		debug(Dumper $config);
		#Dumper $config;
		}
	}

# choose which type of config file to use
sub save_config
	{
	if ($config->{CONFIGFILE} eq "XML")
		{
		print "configtype-XML\n";
		&save_xml_config;
		}
		else
		{
		print "configtype-plain\n";
		&save_plain_config;
		}
	}

# save XML config
sub save_xml_config
	{
	print "saving-XML\n";
	# types in the dialog 
	my @types = (["XML Files", '.xml', 'TEXT'],
               ["All Files", "*"] );
	# Uses standard file dialog for OS
	my $file = $mw->getSaveFile(-filetypes => \@types,
				  -initialfile => 'opensearch',
				  -defaultextension => '.xml');

	my $encoding = "utf-8";
	my $standalone = "yes";
	# open file handle on XML file
	my $output = new IO::File(">$file");
	# stream writer to file
	my $writer = new XML::Writer(OUTPUT => $output,
								DATA_MODE => 'true',
								DATA_INDENT => 1);
	# set XML header
	$writer->xmlDecl($encoding, $standalone);
	# value variable for config
	my $confvalue;
	# XML body
	$writer->startTag("configuration", 
                    "type" => "s:complextype");
		#debug
		$writer->startTag("debug", 
						"type" => "s:integer");
		$confvalue = $config->{DEBUG};
		$writer->characters($confvalue);
		$writer->endTag("debug");
		#configfile
		$writer->startTag("configfile", 
						"type" => "s:string");
		$confvalue = "XML";
		$writer->characters($confvalue);
		$writer->endTag("configfile");
		# host
		$writer->startTag("host", 
						"type" => "s:string");
		$confvalue = $config->{HOST};
		$writer->characters($confvalue);
		$writer->endTag("host");
		#logtofile
		$writer->startTag("logtofile", 
						"type" => "s:integer");
		$confvalue = $config->{LOGTOFILE};
		$writer->characters($confvalue);
		$writer->endTag("logtofile");
		#dloadp
		$writer->startTag("dloadp", 
						"type" => "s:string");
		$confvalue = $config->{DLOADP};
		$writer->characters($confvalue);
		$writer->endTag("dloadp");
		#uagent
		$writer->startTag("uagent", 
						"type" => "s:string");
		$confvalue = $config->{UAGENT};
		$writer->characters($confvalue);
		$writer->endTag("uagent");
		#usedm
		$writer->startTag("usedm", 
						"type" => "s:integer");
		$confvalue = $config->{USEDM};
		$writer->characters($confvalue);
		$writer->endTag("usedm");
		#pwd
		$writer->startTag("pwd", 
						"type" => "s:string");
		$confvalue = $config->{PWD};
		$writer->characters($confvalue);
		$writer->endTag("pwd");
		#debugfile
		$writer->startTag("debugfile", 
						"type" => "s:string");
		$confvalue = $config->{DEBUGFILE};
		$writer->characters($confvalue);
		$writer->endTag("debugfile");
		#dloaddir
		$writer->startTag("dloaddir", 
						"type" => "s:string");
		$confvalue = $config->{DLOADDIR};
		$writer->characters($confvalue);
		$writer->endTag("dloaddir");
		#user
		$writer->startTag("user", 
						"type" => "s:string");
		$confvalue = $config->{USER};
		$writer->characters($confvalue);
		$writer->endTag("user");
		# port
		$writer->startTag("port", 
						"type" => "s:integer");
		$confvalue = $config->{PORT};
		$writer->characters($confvalue);
		$writer->endTag("port");
	# end XML file
	$writer->endTag("configuration");
	$writer->end();
	return;
	}

# Save configuration
sub save_plain_config
	{
	#debug("+save_config");
	print "saving-config\n";
	# types in the dialog 
	my @types = (["Config Files", '.ini', 'TEXT'],
               ["All Files", "*"] );
	# Uses standard file dialog for OS
	my $file = $mw->getSaveFile(-filetypes => \@types,
				  -initialfile => 'opensearch',
				  -defaultextension => '.ini');

	# Write out as a Perl variable list
	open  OUT, ">$file";
		print OUT Dumper $config;
		debug(Dumper $config);
		close (OUT);
	#debug("-save_config");
	print "config-saved: ". $file ."\n";
	return;
	}

# Load configuration 
sub load_config
	{
	#debug("+load_config");
	print "manually-loadconfig\n";
	my $file;
    my $ftype;

	if($config->{CONFIGFILE} eq "XML")
		{
		# Types are listed in the dialog widget
		my @types = (["XML Files", '.xml', 'TEXT'],
					["All Files", "*"] );
		$file = $mw->getOpenFile(-filetypes => \@types);
		$ftype = "XML";
		}
		else
		{
		# Types are listed in the dialog widget
		my @types = (["Config Files", '.ini', 'TEXT'],
					["All Files", "*"] );
		$file = $mw->getOpenFile(-filetypes => \@types);
		$ftype = "INI";
		}

	read_config($file, $ftype);
	debug(Dumper $config);
	#debug("-load_config");
	}

# choose whether to use the XML parser, or the plain text interpretation
sub read_config
	{
	my $file = $_[0];
	my $ftype = $_[1];
	# check whether filename contains 'xml'
	if($ftype eq "XML")
		{
		&read_xml_config($file);
		}
		# anything else is handled at plaintext
		else 
		{
		&read_plain_config($file);
		}
	}

# read the XML config file
sub read_xml_config
	{
	print "reading-config\n";
	my $file = shift;
	# make sure filename is valid
	return unless $file;
	# skip if it doesn't exist
	print "config-exists\n";
	return unless -e $file;

	# empty config directives
	my $val_debug;
	my $val_configfile;
	my $val_host;
	my $val_logtofile;
	my $val_dloadp;
	my $val_uagent;
	my $val_usedm;
	my $val_pwd;
	my $val_debugfile;
	my $val_dloaddir;
	my $val_user;
	my $val_port;

	# parse the XML configuration file
	my $xp = XML::XPath->new(filename => $file);
	
	# check if config kinda matches the requirements...
	my $nodeset = $xp->find('//configuration');
	my @xmlresults; # results
	if (my @nodes = $nodeset->get_nodelist)
		{
		@xmlresults = map($_->string_value, @nodes);

		# get debug from XML
		$nodeset = $xp->find('//debug');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_debug = $xmlresults[0];
			print "parse-xml: Debug: $val_debug \n" if $DEBUG;
			}
		# get configfile from XML
		$nodeset = $xp->find('//configfile');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_configfile = $xmlresults[0];
			print "parse-xml: ConfigFile: $val_configfile \n" if $DEBUG;
			}
		# get host from XML
		$nodeset = $xp->find('//host');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_host = $xmlresults[0];
			print "parse-xml: Host: $val_host \n" if $DEBUG;
			}
		# get logtofile from XML
		$nodeset = $xp->find('//logtofile');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_logtofile = $xmlresults[0];
			print "parse-xml: LogToFile: $val_logtofile \n" if $DEBUG;
			}
		# get dloadp from XML
		$nodeset = $xp->find('//dloadp');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_dloadp = $xmlresults[0];
			print "parse-xml: DownloadP: $val_dloadp \n" if $DEBUG;
			}
		# get uagent from XML
		$nodeset = $xp->find('//uagent');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_uagent = $xmlresults[0];
			print "parse-xml: UAgent: $val_uagent \n" if $DEBUG;
			}
		# get usedm from XML
		$nodeset = $xp->find('//usedm');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_usedm = $xmlresults[0];
			print "parse-xml: UseDM: $val_usedm \n" if $DEBUG;
			}
		# get pwd from XML
		$nodeset = $xp->find('//pwd');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_pwd = $xmlresults[0];
			print "parse-xml: Pwd: $val_pwd \n" if $DEBUG;
			}
		# get debugfile from XML
		$nodeset = $xp->find('//debugfile');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_debugfile = $xmlresults[0];
			print "parse-xml: DebugFile: $val_debugfile \n" if $DEBUG;
			}
		# get dloaddir from XML
		$nodeset = $xp->find('//dloaddir');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_dloaddir = $xmlresults[0];
			print "parse-xml: DloadDir: $val_dloaddir \n" if $DEBUG;
			}
		# get user from XML
		$nodeset = $xp->find('//user');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_user = $xmlresults[0];
			print "parse-xml: User: $val_user \n" if $DEBUG;
			}
		# get port from XML
		$nodeset = $xp->find('//port');
		if (my @nodes = $nodeset->get_nodelist)
			{
			@xmlresults = map($_->string_value, @nodes);
			$val_port = $xmlresults[0];
			print "parse-xml: Port: $val_port \n" if $DEBUG;
			}
		# start using the values from the XML file
		$config = { HOST	=>  "$val_host",
               PORT 		=>	"$val_port",
			   DLOADDIR		=>	"$val_dloaddir",
			   DLOADP		=> 	"$val_dloadp",
               UAGENT 		=>  "$val_uagent",
               DEBUG		=>  "$val_debug",
			   DEBUGFILE	=>	"$val_debugfile",
			   LOGTOFILE	=>	"$val_logtofile",
               CONFIGFILE	=>	"$val_configfile",
			   USEDM		=>	"$val_usedm",
			   USER			=>	"$val_user",
			   PWD			=>	"$val_pwd"
			  };
		}
		else 
		{
		&parse_error($file);
		}
	# indicate parse error when loading xml conf
	sub parse_error
		{
		my $file = $_[0];
		print "parse-error\n";
		debug(PARSEERROR);
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'error',
			-message=>"Config\n" .
						"\nFile does appear valid:\n" .
						"\n$file\n");
		}
	}

# read the plain config file
sub read_plain_config
	{
	print "reading-config\n";

	my $file = shift;
	my $VAR1;	# used by Data::Dumper;

	local ($/);   
	undef $/;

	return unless $file;
	# skip if it doesn't exist
	return unless -e $file;

	open IN, $file;
	my $textfile  = <IN>;
	close (IN);

	#  check for bad data
	$config = eval $textfile;
	}

sub get_status
	{
	print "getting-status\n";

	# call the SOAPSearch/GetStatus subroutine
	&SOAP_GetStatus;

	if ((substr($OS_TYPE, 0, 5)) eq "Win32")
		{
		$diag_perl_ver = `perl -V | find \"version\"`;
			$diag_perl_ver =~ s/Summary of my//gi;
			$diag_perl_ver =~ s/summary of my//gi;
			$diag_perl_ver =~ s/^\s+//; #remove leading spaces
		$diag_ip_addr = `ipconfig | find \"Address\"`;
			$diag_ip_addr =~ s/IP//gi; # no comment
			$diag_ip_addr =~ s/Address//gi; 
			$diag_ip_addr =~ s/. . //gi; #remove dots
			$diag_ip_addr =~ s/://gi; #remove colon
			$diag_ip_addr =~ s/^\s+//; #remove leading spaces
			$diag_ip_addr =~ s/\s+$//; #remove trailing spaces
		}
		elsif ((substr($OS_TYPE, 0, 5)) eq "SunOS")
		{
		$diag_perl_ver = `perl -V`;
			$diag_perl_ver =~ s/Summary of my//gi;
			$diag_perl_ver =~ s/^\s+//; #remove leading spaces
		$diag_ip_addr = `ifconfig eri0 | grep inet`;
			$diag_ip_addr =~ s/inet //gi;
			$diag_ip_addr =~ s/^\s+//; #remove leading spaces
			$diag_ip_addr =~ s/\s+$//; #remove trailing spaces
		}
		elsif ((substr($OS_TYPE, 0, 4)) eq "OS/2")
		{
		$diag_perl_ver = `perl -V`;
			$diag_perl_ver =~ s/Summary of my//gi;
			$diag_perl_ver =~ s/^\s+//; #remove leading spaces
		$diag_ip_addr = `ifconfig lan0 | find "inet"`;
			$diag_ip_addr =~ s/inet //gi;
			$diag_ip_addr =~ s/^\s+//; #remove leading spaces
			$diag_ip_addr =~ s/\s+$//; #remove trailing spaces
		}
		elsif ((substr($OS_TYPE, 0, 3)) eq "BSD")
		{
		$diag_perl_ver = `perl -V`;
			$diag_perl_ver =~ s/Summary of my//gi;
			$diag_perl_ver =~ s/^\s+//; #remove leading spaces
		$diag_ip_addr = "Not Implemented";
		}
		else
		# Assuming Linux,AIX,OS/400,OS/2,Minix,BSD etc are all one thing...
		{
		$diag_perl_ver = `perl -V`;
			$diag_perl_ver =~ s/Summary of my//gi;
			$diag_perl_ver =~ s/^\s+//; #remove leading spaces
		$diag_ip_addr = `ifconfig | grep \"inet addr\" | grep \"Bcast\"`;
			$diag_ip_addr =~ s/inet addr://gi;
			$diag_ip_addr =~ s/^\s+//; #remove leading spaces
			$diag_ip_addr =~ s/\s+$//; #remove trailing spaces
		}

	# stuff values into array $diag_results
	$diag_results = {
					OSTYPE		=> $OS_TYPE,
					PERLVER		=> $diag_perl_ver,
					IPADDR 		=> $diag_ip_addr,
					SERVICE		=> $diag_service,
					PUBLICIP	=> $diag_pub_ip,
					STATUS		=> $diag_status,
					MAINT		=> $diag_maint
					};
	
	# end debug
	return;
	}

# SOAP
# http://datacenter.pelnet.eu/SOAPSearch/Service.asmx?Op=GetStatus
#
sub SOAP_GetStatus
	{
	print "getting-SOAP-response\n";
	my @web;
	$web[0] = 'GetIP';

	my $SOAPClient = SOAP::Lite
		->uri('urn:SOAPSearch/')
		->proxy($url = $config->{DLOADP}."://".($config->{HOST}).":".$config->{PORT}."/SOAPSearch/Service.asmx")
		->on_action(sub{
						sprintf '%s%s', @_ 
#						})
#		->on_debug(sub{
#						print @_
						});
	$result = $SOAPClient->GetStatus(
			SOAP::Data->name('ClientIP')
			->value(SOAP::Data->value(\@web)));

	$diag_service = $result->valueof('//serviceNameReturn');
	$diag_pub_ip = $result->valueof('//ClientIP');
	$diag_status = $result->valueof('//serviceStatReturn');
	$diag_maint = $result->valueof('//serviceMaintReturn');

	# if down, tell user
	if ($diag_maint eq "yes")
		{
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'warning',
			-message=>"Warning!\n\n" .
						"Please check details:" .
						"\n\n" .
						"\nMaintenance Active/Planned");
		}
	if ($diag_status < 1)
		{
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'warning',
			-message=>"Warning!\n\n" .
						"Please check details:" .
						"\n\n" .
						"\nService Unavailable");
		}
		elsif ($diag_status > 1)
		{
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'warning',
			-message=>"Warning!\n\n" .
						"Please check details:" .
						"\n\n" .
						"\nService Restoring or Inactive");
		}

	# the following will output verbose debug to the console in case of SOAP errors, such as an HTTP 500
	unless ($result->fault) 
		{
		if (length ($result->result()) == 0)
			{
			print "result = ".$result->result()."\n";
			}
		} 
		else 
		{
		print "error ".$result->faultstring."\n";
		unless ($result->fault) 
			{
			if (length ($result->result()) == 0)
				{
				print "result = ".$result->result()."\n";
				}
			} 
			else 
			{
			print "error ".$result->faultstring."\n";
			}
		}
	return;
	}

# SOAP
# http://datacenter.pelnet.eu/SOAPSearch/Service.asmx?Op=ListCat
#
sub SOAP_ListCat
	{
	print "getting-menu-contents\n";
	my @web;
	$web[0] = 'ListCat';
	
	# check whether the URL can be built
	if((length($config->{DLOADP})) < 2 || (length($config->{HOST})) < 2 || (length($config->{PORT})) < 1 || ($config->{PORT}) eq "0") 
		{
		# pop up generic error message box
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'error',
			-message=>"An error has occured!\n\n" .
						"Invalid Download Protocol, Host \n" .
						"or Port directives in config. \n");
		}
		else
		{
		my $SOAPClient = SOAP::Lite
			->uri('urn:SOAPSearch/')
			->proxy($url = $config->{DLOADP}."://".($config->{HOST}).":".$config->{PORT}."/SOAPSearch/Service.asmx")
			->on_action(sub{
							sprintf '%s%s', @_ 
#							})
#					->on_debug(sub{
#							print @_
							});
		print "getting-SOAP-response\n";
		$result = $SOAPClient->ListCat(
				SOAP::Data->name('Category')
				->value(SOAP::Data->value(\@web)));

		# set basic menu items
		$opt->configure(-options=>['Select...','------']);

		my @arraycatlist;

		my $countmenuitems = 1;
		foreach my $t ($result->valueof("//Categories/Category"))
			{
			print "adding-item ". $t ."\n";
			$arraycatlist[$countmenuitems] = $t;
			$opt->addOptions([$arraycatlist[$countmenuitems]=>$arraycatlist[$countmenuitems]]);
			$countmenuitems++;
			}

		# tell user were connected
		$mw->messageBox(-title=>"Connection", 
			-message=>"You should now have 3 or more\n".
					"categories listed in the menu.\n");

		# the following will output verbose debug to the console in case of SOAP errors, such as an HTTP 500
		unless ($result->fault) 
			{
			if (length ($result->result()) == 0)
				{
				print "result = ".$result->result()."\n";
				}
			} 
			else 
			{
			print "error ".$result->faultstring."\n";
			unless ($result->fault) 
				{
				if (length ($result->result()) == 0)
					{
					print "result = ".$result->result()."\n";
					}
				} 
				else 
				{
				print "error ".$result->faultstring."\n";
				}
			}
		if($result->fault)
			{
			return $result;
			}
			else
			{
			return;
			}
		}
	}

# SOAP
# http://datacenter.pelnet.eu/SOAPSearch/Service.asmx?Op=SearchFor
#
sub SOAP_SearchFor
	{
	#debug("+SOAP_SearchFor");
	print "search-clicked\n";
	my @web;

	# update progress bar (this will be called a few more times)
	&progress_bar('10');
	# get the local IP without running the conn. test module
	my $local_ip; 
	if ((substr($OS_TYPE, 0, 5)) eq "Win32")
		{
		$local_ip = `ipconfig | find \"Address\"`;
			$local_ip =~ s/IP//gi; # no comment
			$local_ip =~ s/Address//gi; 
			$local_ip =~ s/. . //gi; #remove dots
			$local_ip =~ s/://gi; #remove colon
			$local_ip =~ s/^\s+//; #remove leading spaces
			$local_ip =~ s/\s+$//; #remove trailing spaces
		}
		elsif ((substr($OS_TYPE, 0, 5)) eq "SunOS")
		{
		$local_ip = `ifconfig eri0 | grep inet`;
			$local_ip =~ s/inet //gi;
			$local_ip =~ s/^\s+//; #remove leading spaces
			$local_ip =~ s/\s+$//; #remove trailing spaces
		}
		elsif ((substr($OS_TYPE, 0, 4)) eq "OS/2")
		{
		$local_ip = `ifconfig lan0 | find "inet"`;
			$local_ip =~ s/inet //gi;
			$local_ip =~ s/^\s+//; #remove leading spaces
			$local_ip =~ s/\s+$//; #remove trailing spaces
		}
		elsif ((substr($OS_TYPE, 0, 3)) eq "BSD")
		{
		$local_ip = "Not Implemented";
		}
		else
		# Assuming Linux,AIX,OS/400,OS/2,Minix,BSD etc are all one thing...
		{
		$local_ip = `ifconfig | grep \"inet addr\" | grep \"Bcast\"`;
			$local_ip =~ s/inet addr://gi;
			$local_ip =~ s/^\s+//; #remove leading spaces
			$local_ip =~ s/\s+$//; #remove trailing spaces
		}

	&progress_bar('20');

	# remove single quotes (throws Tk error)
	my $terms = $ent-> get();
		$terms =~ s/'//gi;

	# build the array for the SOAP request
	$web[0] = $SECTIONTOQUERY;
	$web[1] = $terms;
	# this will only work if the conn. test has been executed.
	#$web[2] = $diag_results->{IPADDR};
	$web[2] = $local_ip;
	$web[3] = $config->{UAGENT};

	&progress_bar('30');

	my $have_error = 0;

	if ($web[1] eq "")
		{
		$have_error = 1;
		}
	if ($web[0] eq "Select..." || $web[0] eq "------" || $web[0] eq "")
		{
		$have_error = 2;
		}

	if ($have_error < 1)
		{
		print "Query: $web[1] in $SECTIONTOQUERY\n";
		&progress_bar('40');
		#$SECTIONTOQUERY = $ $menu -> get()
		$resultscountentry->delete(0,'end');
		# get XML object from server and do some 
		# other subroutines, then return.
		# build soap object
		my $soap = SOAP::Lite
			->on_action( sub { join '/', 'urn:SOAPSearch', $_[1] } )
			->proxy($url = $config->{DLOADP}."://".($config->{HOST}).":".$config->{PORT}."/SOAPSearch/Service.asmx");

		&progress_bar('50');

		# build soap method
		my $method = SOAP::Data->name('SearchFor')
			#->attr({xmlns => 'http://localhost:1540/SOAPSearch/Service.asmx'});
			->attr({xmlns => 'urn:SOAPSearch'});

		&progress_bar('60');

		# pass variables to the object
		my @params = ( SOAP::Data->name(strDb => $web[0]), 
               SOAP::Data->name(strTerms => $web[1]),
			   SOAP::Data->name(strClientIP => $web[2]),
			   SOAP::Data->name(strClientAppVer => $web[3]));
		# call service
		my $som = $soap->call($method => @params);

		&progress_bar('70');

		# make array of the returned results
		@arritems = $som->valueof("//results/ResultHit");

		# clear the array that the fill_grid subroutine uses
		@items = ();

		&progress_bar('80');

		# validate the arritems array to avoid a potential Tk exception on a null return query
		if ($#arritems < 1)
			{
			print "no-results\n";
			# pop up generic error message box
			$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
				-icon=>'info',
				-message=>"No results found that match the criteria.\n");
			# reset progress bar
			&progress_bar('0');
			}
			else
			{
			# build new array
			$countitems = 1;
			my $arraycountitems = 0;
			for $arritem (@arritems)
				{
				#print "adding-item ". $arritem ."\n";
					$arritem =~ s/"//gi; # remove quotation marks

					# replace dots with "[dot] "(Perl throws a wobbly on windows about using a dot in a string 
					# in an array in a scrolled widget...)
					$arritem =~ s/\./~dot~/gi;

					# fix for locale issues on *nix (LWP::UserAgent doesn't seem to 'parse' the same on all OS's)
					# could this be an issue with the HTML::Tagset CPAN module... ?
					$arritem =~ s/&gt;/>/gi;
					$arritem =~ s/&lt;/</gi;

					$arritem =~ s/\/\//\//gi; # remove double slashes ("//") and replace with a single "/"
					$arritem =~ s/<li><a href=//gi; # remove first section of link.

					# remove the useless 'HTML end link tag'
					($arritem, my $rest) = split(/></,$arritem);
				$items[$arraycountitems] = ([$countitems, $arritem]);
				$countitems++;
				$arraycountitems++;
				}

			&progress_bar('90');

			# update result counter box
			&result_count($arraycountitems);
			print "items-found:". $arraycountitems ."\n";

			&progress_bar('100');
			&clear_datagrid;
			&create_datagrid($mw);
			#&fill_datagrid;

			# the following will output verbose debug to the console in case of SOAP errors, such as an HTTP 500
			unless ($som->fault) 
				{
				if (length ($som->result()) == 0)
					{
					print "result = ".$som->result()."\n";
					}
				} 
				else 
				{
				print "error ".$som->faultstring."\n";
				unless ($som->fault) 
					{
					if (length ($som->result()) == 0)
						{
						print "result = ".$som->result()."\n";
						}
					} 
					else 
					{
					print "error ".$som->faultstring."\n";
					}
				}
			}
		# end of "if have_error" below
		}
		elsif ($have_error eq "1")
		{
		# when an error occurs due to search term(s)
		print "Query: INVALID in $SECTIONTOQUERY\n";

		# pop up generic error message box
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'error',
			-message=>"An error has occured!\n" .
						"(1)Please check that you have:\n" .
						"\n1: connected to the server\n" .
						"\n2: entered valid search terms\n");
		&progress_bar('0');
		}
		elsif ($have_error eq "2")
		{
		# when an error occurs due to the section choice
		print "Query: $web[0] in INVALID\n";
		$resultscountentry->delete(0,'end');
		# pop up generic error message box
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'error',
			-message=>"An error has occured!\n" .
						"(2)Please check that you have:\n" .
						"\n1: connected to the server\n" .
						"\n2: selected a section to query\n");
		&progress_bar('0');
		}
	#debug("-SOAP_SearchFor");
	return;
	}

# create datagridview
sub create_datagrid 
	{
	$datagrid = shift;

	# take existing array of results from either the soap query, or the default settings
	#my @displayitems = @items;
	my @columns = ("File ID", "Filename");

	# whether to use the (unstable) LWP Download Manager
    if (($config->{USEDM}) eq "1")
		{
		$grid = $datagrid->Scrolled(
			'HList',
			-head       => 1,
			-columns    => scalar @columns,
			-scrollbars => 'e',
			-width      => 100,
			-height     => 18,
			-selectmode => 'single',
			-command => \&download_manager,
			-background => 'white',)->grid(
				-sticky => 'nwse',
				-column => 1, -row => 6,
				-columnspan => 10);
		}
		else
		{
		# if not, then we'll pop up a message box with the URL
			$grid = $datagrid->Scrolled(
        'HList',
        -head       => 1,
        -columns    => scalar @columns,
        -scrollbars => 'e',
        -width      => 100,
        -height     => 18,
		-selectmode => 'single',
		-command => \&download_manager_lite,
        -background => 'white',)->grid(
			-sticky => 'nwse',
			-column => 1, -row => 6,
			-columnspan => 10);
		}

    foreach my $x ( 0 .. $#columns ) 
		{
        $grid->header(
					'create',
					$x,
					-text => $columns[$x],
					-headerbackground => 'gray',
					);
		}
		&fill_datagrid;
	return;
	}

# fill datagrid
sub fill_datagrid 
	{
	#debug("+fill_datagrid");
	# take existing array of results from either the soap query, or the default settings
	my @displayitems = @items;

	foreach my $row_number ( 0 .. $#displayitems ) 
		{
		my $unique_rowname = $displayitems[$row_number]->[1];
        $grid->add($unique_rowname);
        foreach my $x ( 0 .. 1 ) 
			{
            $grid->itemCreate( $unique_rowname, $x,
                -text => $displayitems[$row_number]->[$x] );
			
            #$grid->itemConfigure( $unique_rowname, $x, -text => "don't care" );
            #  if rand > 0.5 and $x == 0;
			}
		}
	# Set the default selection, the FID of the last item
    my $unique_rowname = $displayitems[-1]->[1];
    $grid->selectionSet($unique_rowname);
	#debug("-fill_datagrid");
	return;
	}

# clear datagrid
sub clear_datagrid
	{
	$grid->destroy();
	return;
	}

# download manager (LWP::UserAgent)
sub download_manager
	{
	#debug("+download_manager");
	my $itemtoget = shift;
	# if there has been no search, then make this clear to the DM
	if ($itemtoget eq "results")
		{
		$itemtoget = "/opensearch/INVALID.txt";
		}
	# file to download must contain 'real dots' again.
	$itemtoget =~ s/~dot~/\./gi;

	print "listitem-clicked: $itemtoget\n";
	my $url = $url = $config->{DLOADP}."://".($config->{HOST}).":".$config->{PORT}.$itemtoget;
	# debug
	#print "URL: $url \n";
	my $ua = new LWP::UserAgent;
	my $ua_string = $config->{UAGENT}.$OS_TYPE;
	$ua->agent($ua_string);
	$ua->timeout(15);
	my $req = new HTTP::Request 'GET',$url;

	# get the username and password from the config settings 
	my $http_domain = "\\";
	my $http_user = $config->{USER};
	my $http_pass = $config->{PWD};

	my $browser = LWP::UserAgent->new(
				agent=>$ua_string,
				keep_alive=>'1');

	# Stage 1 of NTLM authentication
	ntlm_domain($http_domain);
	ntlm_user($http_user);
	ntlm_password($http_pass);

	my $Authorization = Authen::NTLM::ntlm();

	my $header = HTTP::Headers->new(
				Content_Type => 'text/html',
				'WWW-Authenticate' => "NTLM");

	$header->header('Authorization' => "NTLM $Authorization");
	my $request = HTTP::Request->new("GET" => $url, $header);
	my $res = $browser->request($request);

	# Stage 2 of authentication
	my $Challenge = $res->header('WWW-Authenticate');
	$Challenge =~ s/^NTLM //g;

	$Authorization = Authen::NTLM::ntlm($Challenge);
	$header->header('Authorization' => "NTLM $Authorization");
	$request = HTTP::Request->new("GET" => $url, $header);

	# send request
	print "retrieving-file\n";
	$res = $browser->request($request);

	# ntlm reset after request
	ntlm_reset();

	if ($res->is_success) 
		{
		&save_download($url, $itemtoget, $res->content);
		}
		else
		{
		print "operation-failed\n";
		# pop up generic error message box
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'error',
			-message=>"Error!\n" .
						"\nUnable to retrieve file.\n" .
						"\nRequest Unsuccessfull.\n");
		}
	#debug("-download_manager");
	return;
	}

# the any-OS download manager which displays a URL you can copy and paste
sub download_manager_lite
	{
	#debug("+download_manager_lite");
	my $itemtoget = shift;
	# if there has been no search, then make this clear to the DM
	if ($itemtoget eq "results")
		{
		$itemtoget = "/opensearch/INVALID.txt";
		}
	# file to download must contain 'real dots' again.
	$itemtoget =~ s/~dot~/\./gi;
	print "listitem-clicked: $itemtoget\n";
	my $url = $config->{DLOADP}."://".($config->{HOST}).$itemtoget;
	# debug
	#print "URL: $url \n";
	if (not defined $h) 
		{
		# if we're on Win32, then we also display the 'Get File' button.
		if ((substr($OS_TYPE, 0, 5)) eq "Win32")
			{
			$h = $mw->DialogBox(-title => "Download Manager Lite", 
						-buttons => ["OK", "Fetch"]);
			}
			else
			{
			$h = $mw->DialogBox(-title => "Download Manager Lite", 
						-buttons => ["OK"]);
			}
		$h->iconimage($icon);
		$p = $h->add('NoteBook', -ipadx=>6, -ipady=>6);
			my $diag_p = $p->add("main", -label => "Download File",
											-underline => 0);
		
		$diag_p->LabEntry(-label => "Download Link: ",
			 -labelPack => [-side => "left", -anchor => "w"],
			 -width => 70,
				-textvariable => \$url)->
				pack(-side => "top", -anchor => "nw");

		$p->pack(-expand => "yes",
			 -fill => "both",
			 -padx => 5, -pady => 5,
			 -side => "top");
		}
	my $result2 = $h->Show;

	# if on Win32, then we'll try and launch the default app associated with the HTTP
	if ((substr($OS_TYPE, 0, 5)) eq "Win32")
		{
		if ($result2 =~ /Fetch/) 
			{
			# replace spaces with '%20', see KB-#020-1
			$url =~ s/ /%20/gi;
			print system "start $url";
			}
		}
	# bugfix for the fact that the Dm Lite otherwise doesn't flush the $h variable :S
	$h = ();
	#debug("-download_manager_lite");
	return;
	}

# Save file with Download Manager
sub save_download
	{
	#debug("+save_download");
	print "saving-file\n";
	my $url = $_[0];
	my $itemtoget = $_[1];
	my $Message = $_[2];
	my $downloaddir = $config->{DLOADDIR};
	my $Flag;

	# get the filename from the $itemtoget string
	my $position = rindex($itemtoget, "/") + 1;
	my $download_file_name = substr($itemtoget, $position);

	# open file handle on target 'output' file
	my $file2handle = $downloaddir.$download_file_name;
	if(open(FILE, "> $file2handle"))
		{
		for(my $i=0 ; $i<10 ; $i++)
			{
			$Flag = flock(FILE,2);
			last if($Flag);
			}

		unless($Flag)
			{
			return 1;
			}
		# dump body into file
		print FILE $Message;
		unless(flock(FILE,8))
			{
			return 1;
			}
		close(FILE);
		}
	# check that file exists
	if (-e $file2handle)
		{
		# pop up generic error message box
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'info',
			-message=>"Download\n" .
						"\nFile has been retrieved:\n" .
						"\n$file2handle \n");
		}
		else
		{
		$mw->messageBox(-title=>"OpenSearch \@Pel.Net", 
			-icon=>'error',
			-message=>"Download\n" .
						"\nFile could not be retrieved:\n" .
						"\n$file2handle \n");
		}
	#debug("-save_download");
	return 0;
	}


#########
# debug #
#########
#  debugging information to shell/console and/or file
sub debug 
	{
	my @msg = shift;
	my $DEBUG_LOG = $config->{LOGTOFILE};
	my $DEBUG_FILE = $config->{DEBUGFILE};
	# if debug is set, but no file is specified prevent unix from creating files from the commands
	if ((length($DEBUG_FILE)) < 2)
		{
		$DEBUG_FILE = "/dev/null";
		}
	if ($DEBUG_LOG eq "1")
		{
		if ((substr($OS_TYPE, 0, 5)) eq "Win32" || (substr($OS_TYPE, 0, 4)) eq "OS/2")
			{
			my $ntime = `time /t`;
			my $ndate = `date /t`;
			chomp($ntime);
			chomp($ndate);
			my $timestamp = $ndate."- ".$ntime." -";
			`echo $timestamp @msg >> $DEBUG_FILE`;
			}
			else
			{
			my $timestamp = `date;`;
			chomp($timestamp);
			`echo "$timestamp - @msg"  >>  $DEBUG_FILE;`;
			#print system "echo `date` - @msg >> $DEBUG_FILE";
			}
		}
	print @msg, "\n" if $DEBUG;
	}