xs2xs.pl

mini http server,可以集成嵌入到程序中,实现简单的web功能

#!/usr/bin/perl

#*____________________________________________________________________________*\
#*
#
# Copyright (c) 1997-2003 John Roy, Holger Zimmermann. All rights reserved.
#
# These sources, libraries and applications are
# FREE FOR COMMERCIAL AND NON-COMMERCIAL USE
# as long as the following conditions are adhered to.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer. 
#
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in
#    the documentation and/or other materials provided with the
#    distribution.
#
# 3. The name of the author may not be used to endorse or promote products
#    derived from this software without specific prior written permission. 
#
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHORS OR ITS CONTRIBUTORS BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
#
#*____________________________________________________________________________*|
#*
#* $Source: /cvsroot/pi3web/Pi3Web_200/Source/Pi3Perl/Pi3PAPI/Pi3/xs2xs.pl,v $
#* $Date: 2003/05/13 18:42:11 $
#*
# Description:
#   Convert text files to windows format.
#
# Parameters
#*____________________________________________________________________________*/

&do_main( @ARGV );

#/*___________________________________________________________________________*\
# *
# Function:
# Synopsis:
# Description:
#\*___________________________________________________________________________*/
sub do_main
	{
	if ( $^O =~ /MSWin32/ )
		{
		local( @args );
		foreach( @_ ) { push @args, glob; };
		@_=@args;
		};
	foreach( @_ )
		{
		print "xs2xs.pl: Scanning $_...\n";
		open( INP, '<'.$_ ) || die "Cannot open file $_ $!\n";
		$current_file = $_;
		&write_file( $_ );
		close( INP );

        # 
        # rename files
        #
        $_ = $current_file;
        rename $_.'_', $_ || die "Cannot rename $_".'_'." to $_ $!\n";
		};
	};

#/*___________________________________________________________________________*\
# *
# Function:
# Synopsis:
# Description:
#\*___________________________________________________________________________*/
sub write_file
{
	local( $file ) = @_;
	$_ = $file.'_';
	open( OUT, '>'.$_ ) || die "Cannot open file $_ $!\n";
	while( <INP> ) {

		if (/PIDBIterator_current\(pIter\, iType\, pKey\)/) {
			print OUT <<END;
PIDBIterator_current(pIter, iType, pKey)
	PIDBIterator *	pIter
	int	iType
	char *	pKey
PREINIT:
	char *	retval;
CODE:
	RETVAL = PIDBIterator_current(pIter, &pKey);
	XSprePUSH;
	sv_setpv(ST(2), (char *)pKey);

	switch (iType) {
		case PIDBTYPE_STRING:
		case PIDBTYPE_RFC822:
			retval = (char *)RETVAL;
			if (retval) {
				PUSHs(newSVpv(retval, strlen(retval)));
			} else {
				PUSHs(newSVpv("", 0));
			};
			break;
		case PIDBTYPE_TREE:
		case PIDBTYPE_USER:
		default: PUSHi(PTR2IV(RETVAL));
	}
END
			readline(*INP);
			readline(*INP);
			readline(*INP);
			print "Applied rule 01... $_";
		} elsif (/PIDB_add\(pTree\, iType\, pKey\, pV\, iFlags\)/) {
			print OUT <<END;
PIDB_add(pTree, iType, pKey, pV, iFlags)
	PIDB *	pTree
	int	iType
	char *	pKey
	void *	pV
	int	iFlags
PREINIT:
	char *	pValue = (char *)SvPV(ST(3),PL_na);
CODE:

	switch (iType) {
		case PIDBTYPE_STRING:
		case PIDBTYPE_RFC822:
			RETVAL = PIDB_add(pTree, iType, pKey, (void *)pValue, iFlags);
			break;
		case PIDBTYPE_TREE:
		case PIDBTYPE_USER:
		default: RETVAL = PIDB_add(pTree, iType, pKey, pV, iFlags);
	}
	XSprePUSH; PUSHi((IV)RETVAL);
END
			readline(*INP);
			readline(*INP);
			readline(*INP);
			readline(*INP);
			readline(*INP);
			print "Applied rule 02... $_";
		} elsif (/PIDB_getIterator\(pTree\, iType\, pKey\, iFlags\)/) {
			print OUT <<END;
PIDB_getIterator(pTree, iType, pKey, iFlags)
	PIDB *	pTree
	int	iType
	char *	pKey
	int	iFlags
CODE:
	if (strlen(pKey)==0) pKey = 0;
	RETVAL = PIDB_getIterator(pTree, iType, pKey, iFlags);
	ST(0) = sv_newmortal();
	sv_setref_pv(ST(0), "PIDBIteratorPtr", (void*)RETVAL);
END
			readline(*INP);
			readline(*INP);
			readline(*INP);
			readline(*INP);
			print "Applied rule 03... $_";
		} elsif (/PIDB_lookup\(pTree\, iType\, pKey\, iFlags\)/) {
			print OUT <<END;
PIDB_lookup(pTree, iType, pKey, iFlags)
	PIDB *	pTree
	int	iType
	char *	pKey
	int	iFlags
PREINIT:
	char *retval;
CODE:
	RETVAL = PIDB_lookup(pTree, iType, pKey, iFlags);
	XSprePUSH;
	switch (iType) {
		case PIDBTYPE_STRING:
		case PIDBTYPE_RFC822:
			retval = (char *)RETVAL;
			if (retval) {
				PUSHs(newSVpv(retval, strlen(retval)));
			} else {
				PUSHs(newSVpv("", 0));
			};
			break;
		case PIDBTYPE_TREE:
		case PIDBTYPE_USER:
		default: PUSHi(PTR2IV(RETVAL));
	}
END
			readline(*INP);
			readline(*INP);
			readline(*INP);
			readline(*INP);
			print "Applied rule 04... $_";
		} elsif (/PIDB_replace\(pTree\, iType\, pKey\, pV\, iFlags\)/) {
			print OUT <<END;
PIDB_replace(pTree, iType, pKey, pV, iFlags)
	PIDB *	pTree
	int	iType
	char *	pKey
	void *	pV
	int	iFlags
PREINIT:
	char *	pValue = (char *)SvPV(ST(3),PL_na);
CODE:
	switch (iType) {
		case PIDBTYPE_STRING:
		case PIDBTYPE_RFC822:
			RETVAL = PIDB_replace(pTree, iType, pKey, (void *)pValue, iFlags);
			break;
		case PIDBTYPE_TREE:
		case PIDBTYPE_USER:
		default: RETVAL = PIDB_replace(pTree, iType, pKey, pV, iFlags);
	}
	XSprePUSH; PUSHi((IV)RETVAL);
END
			readline(*INP);
			readline(*INP);
			readline(*INP);
			readline(*INP);
			readline(*INP);
			print "Applied rule 05... $_";

		} else {
			print OUT $_;
		};
	};
	close( OUT );
};