I've a problem in socket programing with PerlCtrl, the perl code works if I compiled it to e
xe using PerlApp.

It seems that the server can't create a socket and listen when I compile it to dll.

Please help to fix it.

The codes are as follows:

#mysocke.ctrl
##########################################################################
package MyServer;
########################
use IO::Socket;
#################################################################
sub main() {
setup_socket_server();
listening();
}
#################################################################
sub setup_socket_server() {			# setup a socket server
my $server_port = "1234";
	$server = IO::Socket::INET-> new(LocalPort => $server_port,
					Type      =>  SOCK_STREAM,
					Reuse     =>  1,
					Listen    =>  10 )   # or SOMAXCONN
					or die "Couldn't be a tcp server on port $server_port : $@\n";
	$| = 1;
#	$now = localtime;
#	print "$now ->  Socket ready, Listen on port $server_port; ";
}
#################################################################
sub listening() {
$SIG{'CHLD'} = 'IGNORE';

	while(1) {
		($client, $client_address)= $server-> accept();
		$pid = fork(); die "Cannot fork: $!" unless defined($pid);
		if ($pid) {
			while(chomp($request = <$client> )) {
			#	print "$request\#\n";
				print $client "hello\n";
			}
			close($client);
			kill("TERM",$pid);
		}
	}
	close($server);
}
#################################################################
=pod

=begin PerlCtrl

    %TypeLib = (
	PackageName     =>  'MyServer',
	TypeLibGUID     =>  '{8CFD3980-25DB-11D6-AB2D-00B0D09C9491}', # do NOT edit this line
	ControlGUID     =>  '{8CFD3981-25DB-11D6-AB2D-00B0D09C9491}', # do NOT edit this line either
	DispInterfaceIID=>  '{8CFD3982-25DB-11D6-AB2D-00B0D09C9491}', # or this one
	ControlName     =>  'My_Server',
	ControlVer      =>  1,  # increment if new object with same ProgID
			       # create new GUIDs as well
	ProgID          =>  'My.Server',
        LCID            =>  0,
	DefaultMethod   =>  ' ',
	Methods         =>  {
	    	'main' =>  {
                DispID              =>   0,
		RetType             =>   VT_NULL,
		TotalParams         =>   0,
		NumOptionalParams   =>   0,
		ParamList           => [ ],
	    },
	},  # end of 'Methods'
	Properties        =>  {
	},  # end of 'Properties'
    );  # end of %TypeLib

=end PerlCtrl

=cut
#################################################################################

//////////////////////////////////////////////////////////////////////////////////
//mysocket.cpp
#include <Windows.h> 
#include <objbase.h> 
#include <stdio.h> 

/////////////////////////////////////////////////////////////////////////////////////
// Generic function to check the success of an operation.  If the
// This is the CLSID of Segment: 8CFD3981-25DB-11D6-AB2D-00B0D09C9491
const CLSID CLSID_Segment = {0x8CFD3981,0x25DB,0x11D6,{0xAB,0x2D,0x00,0xB0,0xD0,0x9C,0x94,0x
91}};
/////////////////////////////////////////////////////////////////////////////////////
// Generic function to check the success of an operation.  If the
// operation failed, this function prints the formatted error message
// and returns 0.  Otherwise, it returns 1.
int check_success(HRESULT hr) {
	if(SUCCEEDED(hr)) { return 1; }		// If we had success, simply return 1.

	char *szError;				// Error message buffer.

						// Try to format the message and print it out.
	if(FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER|
		FORMAT_MESSAGE_FROM_SYSTEM,
		NULL,
		hr,
		MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
		(LPSTR)&szError, 
		0, 
		NULL) != 0) {
			fprintf(stderr, "Error: %s\n", szError);
			LocalFree(szError);
		} else {
						// If, for some reason, we could not
						// format the error, let the user know.
        		fprintf(stderr, "Unknown error!\n");
		}
	return 0;				// indicate failure
}
/////////////////////////////////////////////////////////////////////////////////////
int segment(IUnknown* pIUnknown) {	// Look up the main() method and invoke it.
HRESULT hr;
int retval;

	IDispatch* pIDispatch = NULL;	// Look up the IDispatch Interface.
	hr = pIUnknown-> QueryInterface(IID_IDispatch, (void**) &pIDispatch);
	if(!check_success(hr)) { return 0; }
    
/*	if(pIDispatch == NULL) {		// Extra checking.
		fprintf(stderr,"Unknown error getting the IDispatch interface.\n");
		return 0;
	}
*/
// Look up the main() function.
	OLECHAR* szReplace[] = { OLESTR("main") }; 
	DISPID dispid = DISPID_UNKNOWN;
	hr = pIDispatch-> GetIDsOfNames(	IID_NULL, 
					szReplace, 
					1, 
					LOCALE_SYSTEM_DEFAULT, 
					&dispid);

	if (check_success(hr)) {	 // If we successfully looked up the method, go on to invoke it.

	VARIANT varResult;		// Create storage for the return value
	VariantInit( &varResult );	// and initialize it.
	EXCEPINFO excepInfo;		// storage for exceptions.
	UINT uArgErr = 0;		// storage for argument errors.
					// Invoke the method.
	DISPPARAMS noParams = {NULL, NULL, 0, 0};

		hr = pIDispatch-> Invoke(dispid, 
					IID_NULL,  
					LOCALE_USER_DEFAULT, 
					DISPATCH_METHOD, 
					&noParams, 
					&varResult, 
					&excepInfo, 
					&uArgErr);
/*
// Make sure the call succeeded, and that the result is a BSTR before displaying it.
		if (check_success(hr)) {
			if (varResult.vt != VT_BSTR) {	// Make sure we got the right return type.
				fprintf(stderr, "Bogus return value (not VT_BSTR) from Hello().\n");
				retval = 0;
			} else {
				wprintf(OLESTR("\nHello.World says '%s'\n"), varResult.bstrVal);
				retval = 1;
			}
		} else {
			retval = 0;
		}
*/
		//wprintf(OLESTR("%s\n"),varResult.bstrVal);
		printf("server started\n");
		
		VariantClear(&varResult);	// Clear the storage we allocated for the result.
	} else { retval = 0; }

	if(pIDispatch != NULL) {		// Release the IDispatch pointer.
		pIDispatch-> Release();
		pIDispatch = NULL;
	}
	return retval;
}
/////////////////////////////////////////////////////////////////////////////////////
extern "C"
int __cdecl
wmain(int argc, wchar_t *argv[]) {
HRESULT hr = S_FALSE;

	hr = CoInitialize(NULL);		// Initialize the COM library.

	if( check_success(hr) ) {		// Declare a pointer of type IUnknown.
		IUnknown* pIUnknown = NULL;	// The CoCreateInstance function makes
						// this point to an instance of Segment.

        					// Invoke CoCreateInstance to launch Segment.
		hr = CoCreateInstance(	CLSID_Segment, 
					NULL, 
					CLSCTX_INPROC_SERVER, 
					IID_IUnknown, 
					(void**)&pIUnknown );

		if( check_success(hr) ) {	 // Extra checking to make sure we have a pointer here.
/*
			if (pIUnknown == NULL) {
				fprintf(stderr, "Unknown error getting the IUnknown interface.\n");
				return 0;
            		}
*/
			segment(pIUnknown);

			if (pIUnknown != NULL) {	// Release the object we created.
				pIUnknown-> Release();
				pIUnknown = NULL;
            		}
		}
	}
	CoUninitialize();
	return 0;
}
/////////////////////////////////////////////////////////////////////////////////////