#!/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://pelliemail.no-ip.info/search/status.asp
# you can also get an XML output of this info at
# - http://pelliemail.no-ip.info/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)
#
#  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://pelliemail.no-ip.info/support/topic.asp?TOPIC_ID=143 for more
# information on getting Tk (and Tcl) installed on Solaris 10, SPARC.
# 
# Please see http://pelliemail.no-ip.info/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://pelliemail.no-ip.info/bugtrack.
#
#
# Main Dependancies
use Tk;
use Data::Dumper;
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)
my $DEBUG = 1;

# allow user to acknowledge that we have been launched
print "........\n\n".
		"#######################################\n".
		"#                                     #\n".
		"#  \@Pel.Net OpenSearch Client         #\n".
		"#                                     #\n".
		"#  build 1000 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 $OS_TYPE = "unknown";
&os_check;

# Default configuration. This will be overwritten by
# "opensearch.ini" at startup, if it exists.
my $config = { HOST			=>  'pelliemail.no-ip.info',
               PORT 		=>	80,
			   DLOADDIR		=>	'',
               UAGENT 		=>  'OpenSearch Perl/Tk v100(beta)',
               DEBUG		=>  1,
			   DEBUGFILE	=>	'',
			   LOGTOFILE	=>	'0',
               CONFIGFILE	=>	0,
			   USEDM		=>	0,
			   USER			=>	'',
			   PWD			=>	''
			  };

# 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.00  -  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);

		# Attempt to load the opensearch.ini configuration file
		my $file = "opensearch.ini";
		my $unixfile = "/etc/opensearch/".$file;
		my $unixhomefile = "$ENV{HOME}/.opensearch/".$file;
		if (-e $unixhomefile)
			{
			print "loading-configfile\n";
			read_config($unixhomefile);
			}
			elsif (-e $unixfile)
			{
			print "loading-configfile\n";
			read_config($unixfile);
			}
			elsif (-e $file)
			{
			print "loading-configfile\n";
			read_config($file);
			}
			else
			{
			print "no-configfile\n";
			}
		# 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;
	$mw->messageBox(-title=>"Connection", 
		-message=>"You should now have 3 or more\n".
					"categoies listed in the menu.\n");
	}

# 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: 1000 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;
	}

# check for a new image online
sub image_check
	{
	my $agent = $config->{UAGENT};
	my $url = "http://pelliemail.no-ip.info/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;
	}

# Connection Test
sub conn_test
	{
	debug("+conn_test");
	print "conntest-clicked\n";
	
	# 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;
		}	
	debug("-conn_test");
	}

# Config DialogBox
sub configuration
	{
	debug("+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(n/a)",
											-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");

		$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");

		$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;
		}
	debug("-configuration");
	}

# Save configuration
sub save_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;
    
	# Types are listed in the dialog widget
	my @types = (["Config Files", '.ini', 'TEXT'],
               ["All Files", "*"] );
  
	$file = $mw->getOpenFile(-filetypes => \@types);

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

# read the config file
sub read_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
	{
	debug("+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
	debug("-get_status");
	return;
	}

# SOAP
# http://pelliemail.no-ip.info/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("http://".($config->{HOST})."/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://pelliemail.no-ip.info/SOAPSearch/Service.asmx?Op=ListCat
#
sub SOAP_ListCat
	{
	print "getting-menu-contents\n";
	my @web;
	$web[0] = 'ListCat';

	my $SOAPClient = SOAP::Lite
		->uri('urn:SOAPSearch/')
		->proxy("http://".($config->{HOST})."/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++;
		}

	# 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://pelliemail.no-ip.info/SOAPSearch/Service.asmx?Op=SearchFor
#
sub 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');

	# build the array for the SOAP request
	$web[0] = $SECTIONTOQUERY;
	$web[1] = $ent -> get();
	# 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("http://".($config->{HOST})."/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');
		
		# 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";
				}
			}
		}
		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');
		}
	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 
	{
	# 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);
	return;
	}

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

# download manager (LWP::UserAgent)
sub 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 = "http://".($config->{HOST}).$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");
		}
	return;
	}

# the any-OS download manager which displays a URL you can copy and paste
sub 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 = "http://".($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("login", -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/) 
			{
			print system "start $url";
			}
		}
	return;
	}

# Save file with Download Manager
sub 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);
		}
	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_LOG eq "1")
		{
		if ((substr($OS_TYPE, 0, 5)) eq "Win32")
			{
			`echo @msg  >> $DEBUG_FILE`;
			}
			else
			{
			`echo "date - @msg"  >>  $DEBUG_FILE`;
			}
		}
	print @msg, "\n" if $DEBUG;
	}