package SSS;
#=======================================================================
# ***************************************************************
# * CGI-SSS(Style Sheets Selector:Three S) Ver.1.1.4            *
# ***************************************************************
# original made by SHIMODA "Piro" Hiroshi
# http://white.sakura.ne.jp/~piro/

#=======================================================================
# Tutorial (���{Oe�A�I�a�3��120?s�ڂ���c����a�ɂ �e�܂�)
#=======================================================================
# 
# This is a package for Perl4 or later.
# 
# ***STEP1: Create the config file
# 
# At first, you have to make a Perl-script like folloing, as
# "SSSinit.pl". Put the file into the directory same to this file.
# ----------------------<SSSinit.pl> start----------------------
# 
# # define styles
# &SSS'addStyle("style1", "/~piro/style1.css", "screen");
# &SSS'addStyle("style2", "/~piro/style2.css\n/~piro/style2sub.css", "screen");
# # Options are "Title", "Path" and "Media".
# # You can use multiple styleseets in a line, like the second sample above.
# # (then you have to split each sheet by "\n")
# # The first style ("style1" in the sample) is the default style.
# # If the title is "" (nullstring), the style will be a permanent
# # stylesheet.
# 
# # Label for "No Style" item
# $SSS'noStyleLabel = 'No Style';
# 
# # the path for cookie whith stores the selected style.
# $SSS'targetRoot = '/~piro/';
# 
# # If you use this script for webpages made by XHTML, set "1".
# # If not, "0". Default is "0".
# $SSS'outputAsXHTML = 1;
# 
# # If you set "1", stylesheets not selected are output as alternate
# # stylesheets. Default is "0".
# $SSS'shouldLinkAlternateStyleSheets = 1;
# # MSIE loads all of alternate stylesheets so I recommend you to use "0".
# 
# # misc.
# $SSS'formLabel      = 'SelectStyle:'; # label of the form
# $SSS'formAccessKey  = 'S';            # accesskey for the form
# $SSS'applyLabel     = 'Go!';          # label of the button
# $SSS'applyAccessKey = 'G';            # accesskey for the button
# 
# 1; # this line is required!
# ----------------------<SSSinit.pl> end------------------------
# 
# 
# ***STEP2: Embed into the header section
# 
# Make a new CGI script as "header.cgi", and call it by SSI in webpages.
# ----------------------<header.cgi> start----------------------
# #!/usr/local/bin/perl
# # You will change this line by your environment.
# 
# require "./SSS.pl"; # load package
# require "./SSSinit.pl"; # load config file
# 
# &SSS'initLinks();
# &SSS'writeLinks();
# # Note: If you hand "1" as the argument, this function doesn't print
# #       Content-type info of the HTTP header.
# #       > &SSS'writeLinks(1);
# 
# ----------------------<header.cgi> end------------------------
# To call this from webpages, embed a line like following, to the head
# section (<head>...</head>) of weblages:
# > <head>
# >  ...
# >  <!--#exec cgi="/~piro/common/scripts/header.cgi"-->
# >  ...
# > </head>
# 
# 
# ***STEP3: Embed the form to switch styles
# 
# Make a new CGI script as "form.cgi" and call by SSI in weblages.
# ----------------------<form.cgi> start------------------------
# #!/usr/local/bin/perl
# # You will change this line by your environment.
# 
# require "./SSS.pl";
# require "./SSSinit.pl";
# 
# &SSS'initForm();
# &SSS'writeForm();
# # Note: If you hand "1" as the argument, this function doesn't print
# #       Content-type info of the HTTP header.
# #       > &SSS'writeForm(1);
# 
# ----------------------<form.cgi> end--------------------------
# To call this from webpages, embed a line like following, to the body
# section (<body>...</body>) of weblages:
# > <body>
# >  ...
# >  <!--#exec cgi="/~piro/common/scripts/form.cgi"-->
# >  ...
# > </body>
# 
# 
# ***Appendix: Tips
# 
# You can switch style by options in the URL, like:
# > http://foo.bar.com/webpage.html?SSSStyle=style1
# When you make a switching menu by simple HTML, this feature will help you.
# 
# Without my agreement, you can use, customize, and re-distribute this.
# You don't have to mail to me, link to my website, and write my name.
# There is no restriction and requirement.
#


#=======================================================================
# �g�c�u
#=======================================================================
# 
# SSS.js�IPerl�A�B
# fpfbfP�[fW�E�I�A�APerl4^E?~�I�A?s�‹��a�K�v�A���B
# 
# 
# �!�ݒeftf@fCf��I?i��
# 
# �܂��A^E�o�I�a���E�a�e�IPerlfXfNf�fvfg�??i�����܂��B
# ftf@fCf��1�͂E�n�A�a�c�c�A���a�ASSS.pl�A����fffBfOfNfgf���
# �u�c�Ă����A�1���A�֗~�A���a���B
# �����A�͗�A���āuSSSinit.pl�v�A�c���1�O�A�ݒeftf@fCf��??i��
# ����a�I�A�1�e���܂��B
# ----------------------<SSSinit.pl> start----------------------
# 
# # fXf^fCf��I�e�`
# &SSS'addStyle("style1", "/~piro/style1.css", "screen");
# &SSS'addStyle("style2", "/~piro/style2.css", "screen");
# # ^o���́ufXf^fCf��1�v�ufV�[fg�IfpfX�v�u�Ή�f�fffBfA�v�I?��B
# # fpfX�́u\n�v�a�O�e�A�!���w�e�”\�Af�fffBfA��fJf�f}�a�O�e�A�B
# # �i^e��?A?��IfXf^fCf��affftfHf�fg�IfXf^fCf��i?��߂�fy�[fW�?
# #   �J�c�1�A���ɁA?���?�ԂA�I�?�3�e�Ăc��fXf^fCf��j�ɂE�e�܂��j
# # fXf^fCf��1�??E�a����A�A�i��fXf^fCf��ɂE�e�܂��B
# # �E���A�a4^o���A����0^E�O�I�l�i1�E�ǁj�?�n���A�A���IfXf^fCf���
# # �O�e�ւ�ftfH�[f��I^e���ɕ\���3�e�E���E�e�܂��i�B��fXf^fCf��j�B
# 
# # �ufXf^fCf��3���v�I�\���1�iffftfHf�fg�́uNo Style�v�j
# $SSS'noStyleLabel = 'No Style';
# 
# # fXf^fCf��I�??�n�ICookie�I�U���pfpfX�iffftfHf�fg�͂��Ify�[fW�IfpfX�j
# $SSS'targetRoot = '/~piro/';
# 
# # XHTML�Ify�[fW�ɑ΂��Ďg�p����?e?��́u1�v�AHTML�A�́u0�v
# # �iffftfHf�fg�́u0�v�j
# $SSS'outputAsXHTML = 1;
# 
# # �I�?�3�e�E�����1fV�[fg�?�a��fXf^fCf�fV�[fg�A����f�f�fN����
# # ?e?��́u1�v�A���E�c?e?��́u0�v�iffftfHf�fg�́u0�v�j
# $SSS'shouldLinkAlternateStyleSheets = 1;
# # IE�A�͑a��fXf^fCf�fV�[fg�܂A�S���ǂ�?��n�A���܂��I�A�A
# # �u0�v�ɂ��Ă����E�c�Afy�[fW�I�ǂ�?��݂a�x���E�邱�A�a� �e�܂�
# 
# # �O�e�ւ�ftfH�[f��I�ݒe
# $SSS'formLabel      = 'SelectStyle:'; # f�fXfg�If�fxf�
# $SSS'formAccessKey  = 'S';            # f�fXfg�IfAfNfZfXfL�[
# $SSS'applyLabel     = 'Go!';          # �A?sf{f^f��If�fxf�
# $SSS'applyAccessKey = 'G';            # �A?sf{f^f��IfAfNfZfXfL�[
# 
# 1; # �Y�e�E�c�a���ɁI
# ----------------------<SSSinit.pl> end------------------------
# 
# 
# �!head�ւI����?���
# 
# ^E�o�I�a���E�a�e�ICGIfXfNf�fvfg�??i�����A<head>�`</head>�I���A
# SSI�A�A?s���ĉo�3�c�B�����A�͉1�Ɂuheader.cgi�v�A���܂��B
# ----------------------<header.cgi> start----------------------
# #!/usr/local/bin/perl
# # �i�aPerl�IfpfX�͊‹���?���1�ĉo�3�c�j
# 
# require "./SSS.pl"; # fpfbfP�[fW�I�ǂ�?���
# require "./SSSinit.pl"; # �ݒeftf@fCf��I�ǂ�?���
# 
# # �ݒe�?�a�A��?�����
# &SSS'initLinks();
# 
# # fXf^fCf�fV�[fg�If�f�fN�??o��
# &SSS'writeLinks();
# # ���1�ICGIfXfNf�fvfg����OĂN?o��?e?��́A^o���u1�v�?�‚���A
# # HTTPfwfbf_�IContent-type�??o�͂��܂1�n
# # &SSS'writeLinks(1);
# 
# ----------------------<header.cgi> end------------------------
# 
# 
# �!�O�e�ւ�ftfH�[f��I����?���
# 
# ^E�o�I�a���EfXfNf�fvfg�?SSI�A�A?s����A�A���I��?���
# fXf^fCf��O�e�ւ��I�1�߂IftfH�[f��a�\���3�e�܂��B
# fXfNf�fvfg�1�́A�����A�͉1�Ɂuform.cgi�v�A���܂��B
# ----------------------<form.cgi> start------------------------
# #!/usr/local/bin/perl
# # �i�aPerl�IfpfX�͊‹���?���1�ĉo�3�c�j
# 
# require "./SSS.pl"; # fpfbfP�[fW�I�ǂ�?���
# require "./SSSinit.pl"; # �ݒeftf@fCf��I�ǂ�?���
# 
# # �ݒe�?�a�A��?�����
# &SSS'initForm();
# 
# # ftfH�[f��??o��
# &SSS'writeForm();
# # ���1�ICGIfXfNf�fvfg����OĂN?o��?e?��́A^o���u1�v�?�‚���A
# # HTTPfwfbf_�IContent-type�??o�͂��܂1�n
# # &SSS'writeForm(1);
# 
# ----------------------<form.cgi> end--------------------------
# 
# 
# �!�֗~�E�g�c�u
# 
# &SSS'initLinks();�I�A?sOa�́A$SSS'styleSheetsLinks��
# &SSS'writeLinks();�A?o�͂���a�e�a�i�[�3�e�܂��B
# �܂1�A&SSS'initForm();�I�A?sOa�́A$SSS'form��&SSS'writeForm();�A
# ?o�͂���ftfH�[f��a�i�[�3�e�܂��BOf���‚E�ǂICGIfXfNf�fvfg�A�g��
# ?���1�Ďg�����E�ǂɗ~�p�A���܂��B
# 
# ���IfXfNf�fvfg�?�g�p���Ăc��fy�[fW�?�u?SSSStyle=fXf^fCf��1�v
# �A�c��^o���?�w�e���ēǂ�?��?�A�A�����I�ɂ��IfXf^fCf��?�K�p���܂��B
# ftfH�[f��?�g�킸��fXf^fCf��O�e�ւ��??s�c�1�c?e?���A���IfXfNf�fvfg�A
# �n�Y�3�e��ftfH�[f��a�C�ɓ���E�c?e?��E�ǂɗ~�p�A���܂��B
# 
#=======================================================================
# 
# �⑫�B
# �1�IfTfCfg�A�g��e��?e?��E�ǁA���?�ւIf�f�fN�a�~?iO �\���a���I�a
# ?Ĕz�z�a�S�Ď��R�A���܂��B
# 
#=======================================================================
# ���?�F
# 2003/3/1   Ver.1.0   JavaScript����Perl��^ڐA
# 2003/3/1   Ver.1.1   ftfH�[f��I?������u�@�?�I?X
# 2003/3/3   Ver.1.1.1 HTML�If~fX�??C�3
# 2003/3/9   Ver.1.1.2 f�f�fN�I?o�͂??C�3
# 2003/3/21  Ver.1.1.3 f^fCfgf��I�E�cfXf^fCf�fV�[fg�?�i��fXf^fCf�fV�[fg
#                      �A����?o�͂���a���ɂ��1
# 2003/4/29  Ver.1.1.4 fXf^fCf��?�O�e�ւ�f�fXfg����B���ݒe�?�lj�
#=======================================================================


#=======================================================================
# fwfbf_�p

$noStyleLabel   = 'No Style';
$targetRoot     = '';
$outputAsXHTML  = 0;
$shouldLinkAlternateStyleSheets = 0;

$selected       = '';
$selectedIndex  = 1;

$styleSheetsLinks = '';


@stylesID       = ('');
%stylesNum      = ('', 0);
@stylesPath     = ('');
@stylesMedia    = ('all');
@stylesHidden   = (0);

$mSlashForXHTML = '';


#-----------------------------------------------------------------------
# ?�����
#-----------------------------------------------------------------------
sub initLinks
{
	$stylesID[0]         = $noStyleLabel;
	$stylesNum{$noStyleLabel} = 0;

	if ($outputAsXHTML != 0) {
		$mSlashForXHTML = ' /';
	}

	&get_cookies();
	&decode_input();
	&getSelectedStyle();
	&makeStyleSheetsLinks();
}


#-----------------------------------------------------------------------
# f�f�fN�I?o��
# [0] = f��[fh 0:SSI�p 1:fXfNf�fvfg�aOĂN?o���iContent-type�??o�͂��E�c�j
#-----------------------------------------------------------------------
sub writeLinks
{
	local ($stored_selected);

	if ($_[0] != 1) {
		print "Content-type: text/html\n\n";

		if ($FORM{'SSSStyle'} ne '') {
			$stored_selected = $FORM{'SSSStyle'};
		}
		else {
			$stored_selected = $COOKIES{'SSSSelectedStyle'};
		}

		if ($stored_selected ne '') {
			&put_cookie('SSSSelectedStyle', $selected, 30, $targetRoot, 1);
		}
	}
	print "$styleSheetsLinks\n";

	&debugDump();
}


#-----------------------------------------------------------------------
# �I�?�3�e�1fXf^fCf��?�3��
#-----------------------------------------------------------------------
sub getSelectedStyle
{
	local ($stored_selected);

	if ($FORM{'SSSStyle'} ne '') {
		$stored_selected = $FORM{'SSSStyle'};
	}
	else {
		$stored_selected = $COOKIES{'SSSSelectedStyle'};
	}

	if (
		$stored_selected eq '' ||
		(
			$stored_selected ne $stylesID[0] &&
			$stylesNum{$stored_selected} eq ''
		)
		) {
		$selected      = $stylesID[1];
		$selectedIndex = 1;
	}
	else {
		$selected      = $stored_selected;
		$selectedIndex = $stylesNum{$stored_selected};
	}

	if ($ENV{'DOCUMENT_URI'} ne '') {
		if ($stored_selected ne '') {
			&put_cookie('SSSSelectedStyle', $selected, 30, $targetRoot);
		}
	}
}


#-----------------------------------------------------------------------
# fXf^fCf�fV�[fg�ւIf�f�fN�?����
#-----------------------------------------------------------------------
sub makeStyleSheetsLinks
{
	local ($name, $ii, @links, @work, $work);

	$ii = 0;
	foreach $name (@stylesID)
	{
		if ($name eq '') {
			@work = split(/\n/, $stylesPath[$ii]);
			foreach $work (@work)
			{
				push(@links, "<link rel=\"stylesheet\" href=\"$work\" type=\"text/css\" media=\"$stylesMedia[$ii]\"$mSlashForXHTML>");
			}
		}
		elsif ($ii == $selectedIndex) {
			@work = split(/\n/, $stylesPath[$ii]);
			foreach $work (@work)
			{
				push(@links, "<link rel=\"stylesheet\" title=\"$name\" href=\"$work\" type=\"text/css\" media=\"$stylesMedia[$ii]\"$mSlashForXHTML>");
			}
		}
		elsif ($shouldLinkAlternateStyleSheets != 0) {
			@work = split(/\n/, $stylesPath[$ii]);
			foreach $work (@work)
			{
				push(@links, "<link rel=\"alternate stylesheet\" title=\"$name\" href=\"$work\" type=\"text/css\" media=\"$stylesMedia[$ii]\"$mSlashForXHTML>");
			}
		}
		$ii++;
	}

	$styleSheetsLinks = join("\n", @links);
}


#-----------------------------------------------------------------------
# fXf^fCf��e�`
# [0] = �1�O
# [1] = fV�[fg�IURI�i\n�a�O�e�A�!���w�e�j
# [2] = f�fffBfA
# [3] = f�fXfg����B�����ǂ����i0�E��B�3�E�c�A���e^E�O�E��B���j
#-----------------------------------------------------------------------
sub addStyle
{
	local ($ii);
	$ii = $#stylesID + 1;

	$stylesNum{$_[0]}    = $ii;
	$stylesID[$ii]       = $_[0];
	$stylesPath[$ii]     = $_[1];

	if ($_[2] eq '') {
		$stylesMedia[$ii] = 'all';
	}
	else {
		$stylesMedia[$ii] = $_[2];
	}

	if ($_[3] eq '') {
		$stylesHidden[$ii] = 0;
	}
	else {
		$stylesHidden[$ii] = 1;
	}
}



#=======================================================================
# ftfH�[f��p

$formLabel      = '';
$formAccessKey  = '';
$applyLabel     = '';
$applyAccessKey = '';
@stylesLabel    = ('');
@stylesGroup    = ('');
$form           = '';

sub initForm
{
	local ($ii, $max, @stylesLabel, @stylesGroup, $id, $options, @option, @work, $work);

	$stylesID[0]              = $noStyleLabel;
	$stylesNum{$noStyleLabel} = 0;

	&get_cookies();
	&decode_input();

	# fhf?fbfvf_fEf�f�fXfg�?����

	$ii = 0;
	foreach $id (@stylesID)
	{
		if ($id =~ /\@/) {
			$_ = $id;
			s/@.*$//;
			$stylesLabel[$ii] = $_;

			$_ = $id;
			s/^[^@]*@//;
			$stylesGroup[$ii] = $_;
		}
		else {
			$stylesLabel[$ii] = $id;
			$stylesGroup[$ii] = '';
		}
		$ii++;
	}

	&getSelectedStyle(1);


	$max  = $#stylesID;
	@option = ('');
	@work = ('');
	for ($ii = 1; $ii < $max; $ii++)
	{
		$id = $stylesID[$ii];

		if ($id eq $selected) {
			$work = ' selected="selected"';
		}
		else {
			$work = '';
		}

		if ($id ne '' &&
			$stylesHidden[$ii] != 1) {
			push(@work, "<option value=\"$id\" label=\"$stylesLabel[$ii]\"$work>$id\</option>");
		}

		if ($ii == $max-1 ||
			$stylesGroup[$ii] ne $stylesGroup[$ii+1]) {
			$work = join("\n", @work);
			if ($stylesGroup[$ii] ne '') {
				$work = "<optgroup label=\"$stylesGroup[$ii]\">\n$work\n</optgroup>";
			}
			push(@option, $work);
			@work = ('');
		}
	}
	push(@option, "<option value=\"$stylesID[0]\" label=\"$stylesLabel[0]\">$stylesID[0]</option>");
	$options = join("\n", @option);


	if ($outputAsXHTML != 0) {
		$mSlashForXHTML = ' /';
	}

	$form =
<<________________________HTML_DATA________________________;
	<form id="SSSStyleSelectForm" method="get" action="$ENV{'DOCUMENT_URI'}">
		<div class="SSSStyleSelectFormInnerBox">
			<label for="SSSStyle" accesskey="$formAccessKey">$formLabel
				<select id="SSSStyle" name="SSSStyle">
$options
				</select>
			</label>
			<input type="submit" value="$applyLabel" accesskey="$applyAccessKey"$mSlashForXHTML>
		</div>
	</form>
________________________HTML_DATA________________________
}

# [0] = f��[fh 0:SSI�p 1:fXfNf�fvfg�aOĂN?o���iContent-type�??o�͂��E�c�j
sub writeForm
{
	if ($_[0] != 1) {
		print "Content-type: text/html\n\n";
	}
	print $form;

	&debugDump();
}



#=======================================================================
# Cookie���a�NftfH�[f��l�I?^�?�ipicoBBS�a�e�]�p�j

#-----------------------------------------------------------------------
# fNfbfL�[�a�3
#-----------------------------------------------------------------------
sub get_cookies
{
	local ($work, $name, $value);
	for $work (split(/; */, $ENV{'HTTP_COOKIE'})) {
	    ($name, $value) = split(/=/, $work);
	    $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
	    $COOKIES{$name} = $value;
	}
}

#-----------------------------------------------------------------------
# fNfbfL�[?o��
# [0] = �1�O
# [1] = �l
# [2] = ��OA
# [3] = fpfX
# [4] = f��[fh 0:HTTPfwfbf_ 0^E�O:METAf^fO
#-----------------------------------------------------------------------
sub put_cookie
{
	local($str, $limit, $value, $path);

	$COOKIES{$_[0]} = $_[1];
	$value = $_[1];
	$value =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
	$limit = gmtime(time + (86400 * $_[2]));
	$limit =~ s/^(...) (...) (..) (........) (....).*/$1, $3-$2-$5 $4 GMT\;/;

	if ($_[3] ne '') {
		$path = " path=$_[3];";
	}
	else {
		$path = '';
	}

	if ($_[4] == 0) {
		print "Set-Cookie: $_[0]=$value; expires=$limit$path\n";
	}
	else {
		print "<meta http-equiv=\"Set-Cookie\" content=\"$_[0]=$value; expires=$limit$path\"$mSlashForXHTML>\n";
	}
}


#-----------------------------------------------------------------------
# ftfH�[f��l�IfffR�[fh
#-----------------------------------------------------------------------
sub decode_input
{
	local ($query_string, $work, @work, $name, $value);
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
#		read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
		$query_string = '';
	}
	else {
		$query_string = $ENV{'QUERY_STRING'};
	}
	@work = split(/&/, $query_string);
	foreach $work (@work) {
		($name, $value) = split(/=/, $work);
		$value =~ tr/+/ /;
		$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
#		&jcode'convert(*value, "euc");
		$FORM{$name} = $value;
	}
}





sub debugDump
{
print "<!--\n";
print "selected : $selected ($selectedIndex)\n";
foreach $name (@stylesID) {
	print "  $name ($stylesNum{$name})\n";
}
print "-->\n";
}


1;